CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:dprt

Table of Contents

DPRT

Table Of Contents

  • [00551] -SETUP-
  • [00559] LOAD TIME INITIALIZATIONS
  • [00642] READ DATA FILE
  • [00648] -GETLINE- GET NEXT DATA RECORD
  • [00743] -ISTLIN- INITIALIZATIONS
  • [00777] -DISKIN-
  • [00783] ATTACH FILE
  • [00811] DETACH PLATO FILE
  • [00824] READ BLOCK FROM PLATO DISK FILE
  • [00876] OUTPUT FORMATTING
  • [00881] -ANSFORM-
  • [00958] -OUTFORM-
  • [01152] OCTAL TO ALPHA CONVERSION
  • [01186] -VFORM-
  • [01199] -FILL- FILL -OUTBUF-
  • [01234] ZERO TO BLANK ROUTINE
  • [01300] FIND END OF LINE

Source Code

DPRT.txt
  1. DPRT
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK DEFINES 00 000 80/01/25 00.46
  4. * OVERLAY(DPRINT,0,0)
  5. PROGRAM DPRINT(INPUT,OUTPUT)
  6. C
  7. C
  8. C PRINT TUTOR STUDENT DATA
  9. C
  10. C
  11. IMPLICIT INTEGER (A-Z)
  12. C
  13. COMMON /GETLINE/ PRTDEN,INFO(3),LINE(64),BLOCK,NXT,END
  14. C
  15. COMMON /OUTPUT/ OUTBUF(11),LTH,TERMX(2),TIME,DATE
  16. C
  17. COMMON /DISK/ DISKF1,DISKF2,BUFF(320)
  18. C
  19. REAL V
  20. C
  21. EQUIVALENCE (PDEN,PRTDEN)
  22. EQUIVALENCE (FILE,INFO(1))
  23. EQUIVALENCE (BLOCKS,INFO(2))
  24. EQUIVALENCE (TBLKS,INFO(3))
  25. C
  26. EQUIVALENCE (NAME,LINE(2))
  27. EQUIVALENCE (NAME1,LINE(3))
  28. EQUIVALENCE (LESSON,LINE(4))
  29. EQUIVALENCE (AREA,LINE(5))
  30. C
  31. DIMENSION STATE(12)
  32. DIMENSION ETYPE(14)
  33. DIMENSION MESS1(4)
  34. DIMENSION MESS2(2)
  35. C
  36. * /--- BLOCK STARTUP 00 000 80/02/01 00.46
  37. C
  38. 1 ETYPE(1)=10LUNKNOWN ER
  39. ETYPE(2)=10LROR
  40. ETYPE(3)=10LILLEGAL CO
  41. ETYPE(4)=10LMMAND
  42. ETYPE(5)=10LMISSING UN
  43. ETYPE(6)=10LIT
  44. ETYPE(7)=10LTIME SLICE
  45. ETYPE(8)=10L EXCEEDED
  46. ETYPE(9)=10LTUTOR OUTF
  47. ETYPE(10)=10LOW
  48. ETYPE(11)=10LSTATION OU
  49. ETYPE(12)=10LTFLOW
  50. ETYPE(13)=10LILL ACTION
  51. ETYPE(14)=10LREQUEST
  52. C
  53. STATE(1)=10LREG PRE-AR
  54. STATE(2)=10LROW
  55. STATE(3)=10LREG POST-A
  56. STATE(4)=10LRROW
  57. STATE(5)=10LJUDGING
  58. STATE(6)=10L
  59. STATE(7)=10LREG POST-J
  60. STATE(8)=10LUDGE
  61. STATE(9)=10LSEARCH
  62. STATE(10)=10L
  63. STATE(11)=10LUNKNOWN ST
  64. STATE(12)=10LATE
  65. C
  66. MESS1(1)=10LCONTINUATI
  67. MESS1(2)=10LON OF PREV
  68. MESS1(3)=10LIOUS SESSI
  69. MESS1(4)=10LON
  70. C
  71. C GET CM/ECS/TIME/DATE/NAME OF FILE
  72. C
  73. CALL SETUP
  74. C
  75. C
  76. C 'IF PDEN = 0, SET HIGH DENSITY
  77. C
  78. IF (PDEN.EQ.0) PRINT 1007
  79. C
  80. C PAGE EJECT
  81. 7 PRINT 1000
  82. C
  83. C PRINT DAYFILE PRINT INFO IF ANY
  84. C
  85. IF (LINE(1).EQ.0) GOTO 8
  86. CALL IBFILLB(LINE(1),20)
  87. PRINT 1008,(LINE(I),I=1,4)
  88. PRINT 1008,(LINE(I),I=5,8)
  89. PRINT 1008,(LINE(I),I=9,12)
  90. PRINT 1008,(LINE(I),I=13,16)
  91. PRINT 1008,(LINE(I),I=17,20)
  92. PRINT 1009
  93. PRINT 1010
  94. 8 DO 9 I = 1,20
  95. 9 LINE(I) = 0
  96. CALL FILL (10L**********)
  97. PRINT 1001,(OUTBUF(I),I=1,11)
  98. CALL ATTACH (FILE)
  99. CALL IBFILL(FILE,TIME,DATE)
  100. PRINT 1002,FILE,TIME,DATE
  101. CALL DISKIN (0)
  102. TBLKS=BUFF(3)
  103. C NUMBER OF BLOCKS IN USE
  104. BLOCKS = BUFF(4).AND.(77777B)
  105. C PRINT FILE INFORMATION
  106. CALL IBFILLB(BUFF(9),10)
  107. PRINT 1005,(BUFF(J),J=9,13)
  108. PRINT 1006,(BUFF(J),J=14,18)
  109. PRINT 1001,(OUTBUF(I),I=1,11)
  110. 111 CALL ISTLIN
  111. IF (END.NE.0)GOTO 90
  112. C
  113. * /--- BLOCK MAIN LOOP 00 000 78/07/02 17.11
  114. C
  115. C
  116. C MAIN LOOP - PROCESS NEXT DATA RECORD
  117. C
  118. 10 CALL GETLINE
  119. IF(END.NE.0)GOTO 90
  120. TYPE=LINE(1).AND.77B
  121. LTH=(ISHR(LINE(1),6)).AND.77B
  122. IF(TYPE.EQ.0)GOTO 90
  123. IF(TYPE.GT.13)GOTO 10
  124. C IF(TYPE-9)X,X,10
  125. GOTO(100,200,300,400,500,600,700,800,900,550,560,10,1300)TYPE
  126. C
  127. C
  128. C
  129. C -OUTPUT- COMMAND DATA
  130. C
  131. 100 II=ISHL(((ISHL(LINE(1),30)).AND.777777B),7)
  132. V=II/60000.0
  133. CALL IBFILL(NAME,NAME1,LESSON,AREA)
  134. PRINT 2100,V,NAME,NAME1,LESSON,AREA
  135. CALL OUTFORM
  136. CALL IBFILLB(OUTBUF,11)
  137. PRINT 2110,(OUTBUF(I),I=1,11)
  138. GOTO 10
  139. C
  140. 2100 FORMAT (3X,*OUTPUT*,4X,F5.1,4X,A10,A8,3X,A10,2X,
  141. * *AREA *,A10)
  142. 2110 FORMAT (22X,11A10,/)
  143. C
  144. C
  145. C
  146. C STUDENT RESPONSE
  147. C
  148. 200 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
  149. V=II/60000.0
  150. ARR=(ISHL(LINE(1),33)).AND.777B
  151. N1=0
  152. N2=0
  153. IF((ISHL(LINE(1),36)).GE.0)GOTO 210
  154. N1=10LUNRECOGNIZ
  155. N2=10LED WORD
  156. GOTO 220
  157. C
  158. 210 IF(((ISHL(LINE(1),24)).AND.77B).NE.3)GOTO 220
  159. N1=10HUNRECOGNIZ
  160. N2=7HED -NO-
  161. C
  162. 220 CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6),N1,N2)
  163. PRINT 2200,V,NAME,NAME1,LESSON,AREA,LINE(6),ARR,
  164. * N1,N2
  165. CALL ANSFORM
  166. CALL IBFILLB(OUTBUF(1),11)
  167. PRINT 2210,(OUTBUF(I),I=1,11)
  168. GOTO 10
  169. C
  170. 2200 FORMAT (3X,*RESPONSE *,F5.1,4X,A10,A8,3X,A10,
  171. * 2X,*AREA *,A10,2X,*UNIT *,A8,3X,*ARROW*,I3,
  172. * 10X,2A10)
  173. 2210 FORMAT (22X,11A10,/)
  174. C
  175. * /--- BLOCK AREA/TERM 00 000 77/11/12 01.38
  176. C
  177. C
  178. C -AREA- COMMAND DATA
  179. C
  180. 300 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
  181. V=II/60000.0
  182. IF((ISHL(LINE(8),18)).GE.0)GOTO 310
  183. N6=8HCOMPLETE
  184. GOTO 320
  185. C
  186. 310 N6=10HINCOMPLETE
  187. C
  188. 320 CALL IBFILL(NAME,NAME1,LESSON,AREA,N6)
  189. PRINT 2300,V,NAME,NAME1,LESSON,AREA
  190. N1=ISHL(((ISHL(LINE(8),18)).AND.777777B),7)
  191. V=N1/60000.0
  192. N1=LINE(6).AND.777B
  193. N2=(ISHR(LINE(7),9)).AND.777B
  194. N3=(ISHR(LINE(7),18)).AND.777B
  195. PRINT 2310,V,N1,N2,N3
  196. N1=(ISHR(LINE(6),36)).AND.777B
  197. N2=(ISHR(LINE(6),27)).AND.777B
  198. N3=LINE(7).AND.777B
  199. N4=(ISHR(LINE(7),27)).AND.777B
  200. PRINT 2320,N1,N2,N3,N4
  201. N1=(ISHR(LINE(6),18)).AND.777B
  202. N2=(ISHR(LINE(6),9)).AND.777B
  203. PRINT 2330,N1,N2
  204. IF((ISHL(LINE(8),19)).GE.0)GOTO 330
  205. PRINT 2340,N6,MESS1(1),MESS1(2),MESS1(3),MESS1(4)
  206. GOTO 10
  207. 330 PRINT 2345,N6
  208. GOTO 10
  209. C
  210. 2300 FORMAT (3X,*AREA*,6X,F5.1,4X,A10,A8,3X,A10,2X,
  211. * *AREA *,A10)
  212. 2310 FORMAT (22X,*ELAPSED *,F5.1,8X,*ARROWS *,I4,5X,
  213. * *ANSWERS OK*,I4,5X,*OK IST TRY*,I4)
  214. 2320 FORMAT (22X,*TERMS OK*,I4,9X,*TERMS NO*,I4,5X,
  215. * *ANSWERS NO*,I4,5X,*UNRECOG NO*,I4)
  216. 2330 FORMAT (22X,*HELPS OK*,I4,9X,*HELPS NO*,I4)
  217. C
  218. 2340 FORMAT (22X,A10,2X,4A10,/)
  219. C
  220. 2345 FORMAT (22X,A10,/)
  221. C
  222. C
  223. C
  224. C TERM KEY DATA
  225. C
  226. 400 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
  227. V=II/60000.0
  228. CALL IBFILL(NAME,NAME1,LESSON,AREA)
  229. PRINT 2400,V,NAME,NAME1,LESSON,AREA
  230. TERM=LINE(6).AND.77777777777777770000B
  231. TERM1=(LINE(6).AND.1)+1
  232. TERM1=TERMX(TERM1)
  233. CALL IBFILL(TERM,TERM1)
  234. PRINT 2410,TERM,TERM1
  235. GOTO 10
  236. C
  237. 2400 FORMAT (3X,*TERM*,6X,F5.1,4X,A10,A8,3X,A10,2X,
  238. * *AREA *,A10)
  239. 2410 FORMAT (22X,A8,13X,A10,/)
  240. C
  241. * /--- BLOCK SIGN/OUTL 00 000 76/08/21 12.06
  242. C
  243. C
  244. C STUDENT SIGN-ON
  245. C
  246. 500 II=LINE(1).AND.77777 77777 00000 00000B
  247. CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
  248. PRINT 2500,NAME,NAME1,LESSON,LINE(5),II
  249. GOTO 10
  250. C
  251. 2500 FORMAT (3X,*SIGNIN*,13X,A10,A8,3X,A10,
  252. * 1X,A10,6X,A5,/)
  253. C
  254. C
  255. C
  256. C
  257. C STUDENT SIGN-OFF
  258. C
  259. 550 II=LINE(1).AND.77777 77777 00000 00000B
  260. V=LINE(6)/60000.0
  261. CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
  262. PRINT 2550,NAME,NAME1,LESSON,LINE(5),II,V
  263. GOTO 10
  264. C
  265. 2550 FORMAT (3X,*DATAOFF*,12X,A10,A8,3X,A10,
  266. * 1X,A10,6X,A5,6X,F5.1,/)
  267. C
  268. C
  269. C
  270. C STUDENT SIGNOFF (2)
  271. C
  272. 560 II=LINE(1).AND.77777 77777 00000 00000B
  273. CALL IBFILL(NAME,NAME1,LESSON,LINE(5),II)
  274. PRINT 2560,NAME,NAME1,LESSON,LINE(5),II
  275. N3=LINE(6).AND.77777 77777B
  276. IF(LINE(6).GE.0)GOTO 561
  277. N1=10HNOT COMPLE
  278. N2=3HTED
  279. PRINT 2561,N3,N1,N2
  280. GOTO 570
  281. C
  282. 561 N1=10HCOMPLETION
  283. N2=5H TIME
  284. N4=(ISHL(LINE(6),30)).AND.77777 77777B
  285. PRINT 2562,N3,N1,N2,N4
  286. 570 GOTO 10
  287. C
  288. 2560 FORMAT (3X,*SIGNOFF*,12X,A10,A8,3X,A10,
  289. * 1X,A10,6X,A5,6X)
  290. 2561 FORMAT (22X,*ELAPSED TIME*,3X,I4,6X,A10,A10,/)
  291. 2562 FORMAT (22X,*ELAPSED TIME*,3X,I4,6X,A10,A10,
  292. * 3X,I4,/)
  293. C
  294. C
  295. C
  296. C -HELP- KEY DATA
  297. C
  298. 600 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
  299. V=II/60000.0
  300. CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6))
  301. PRINT 2600,V,NAME,NAME1,LESSON,AREA,LINE(6)
  302. N1=LINE(8).AND.(-777777B)
  303. N2=LINE(7).AND.(-7777B)
  304. IF(N2.NE.0)GOTO 610
  305. N2=7LNO UNIT
  306. C
  307. 610 CALL IBFILL(N1,N2)
  308. PRINT 2610,N1,N2
  309. GOTO 10
  310. C
  311. 2600 FORMAT (3X,*HELP*,6X,F5.1,4X,A10,A8,3X,A10,
  312. * 2X,*AREA *,A10,2X,*UNIT *,A8)
  313. 2610 FORMAT (22X,A7,3X,A8,/)
  314. C
  315. C
  316. C
  317. C -OUTPUTL- COMMAND DATA
  318. C
  319. 700 II=ISHL(((ISHL(LINE(1),18)).AND.777777B),7)
  320. V=II/60000.0
  321. CALL IBFILL(NAME,NAME1,LESSON,AREA,LINE(6))
  322. PRINT 2700,V,NAME,NAME1,LESSON,AREA,LINE(6)
  323. II=LTH-6
  324. IF(II.LE.0)GOTO 715
  325. C
  326. DO 710 I=1,II
  327. N1=LINE(6+I)
  328. CALL VFORM (N1,V)
  329. N2=N1
  330. CALL IBFILL(N2)
  331. PRINT 2710,N2,N1,N1,V
  332. C
  333. 710 CONTINUE
  334. 715 PRINT 1004
  335. GOTO 10
  336. C
  337. 2700 FORMAT (3X,*OUTPUT-L *,F5.1,4X,A10,A8,3X,A10,
  338. * 2X,*AREA *,A10,2X,*LABEL *,A10)
  339. 2710 FORMAT (22X,A10,2X,I10,3X,O20,3X,F10.4)
  340. C
  341. * /--- BLOCK EXEC ERR 00 000 76/08/21 11.56
  342. C
  343. C
  344. C EXECUTION ERROR DATA
  345. C
  346. 800 CALL IBFILL(NAME,NAME1,LESSON,LINE(6))
  347. PRINT 2800,NAME,NAME1,LESSON,LINE(6)
  348. NERROR=(ISHL(LINE(1),6)).AND.77B
  349. IF(NERROR.LE.0)GOTO 805
  350. IF(NERROR.LE.6)GOTO 810
  351. C
  352. 805 N1=ETYPE(1)
  353. N2=ETYPE(2)
  354. GOTO 812
  355. C
  356. 810 II=2*NERROR+1
  357. N1=ETYPE(II)
  358. N2=ETYPE(II+1)
  359. C
  360. 812 N3=(ISHL(LINE(1),21)).AND.777B
  361. II=(ISHL(LINE(1),12)).AND.77B
  362. IF(II.LE.4)GOTO 820
  363. II=5
  364. C
  365. 820 II=2*II+1
  366. N4=STATE(II)
  367. N5=STATE(II+1)
  368. CALL IBFILL(N1,N2,LINE(7),LINE(8),N4,N5)
  369. PRINT 2810,N1,N2,LINE(7),LINE(8),N3,N4,N5
  370. N1=(ISHL(LINE(1),30)).AND.77B
  371. IF(N1.LE.0)GOTO 870
  372. N2=LINE(9).AND.(-7777B)
  373. N3=LINE(9).AND.777B
  374. CALL IBFILL(N2)
  375. PRINT 2820,N2,N3
  376. IF(N1.LE.1)GOTO 870
  377. C
  378. DO 850 II=2,N1
  379. N2=LINE(8+II).AND.(-7777B)
  380. N3=LINE(8+II).AND.777B
  381. CALL IBFILL(N2)
  382. PRINT 2830,N2,N3
  383. 850 CONTINUE
  384. C
  385. 870 PRINT 1004
  386. GOTO 10
  387. C
  388. 2800 FORMAT (3X,*EXECUTION ERROR*,4X,A10,A8,3X,A10,
  389. * 2X,*UNIT *,A8)
  390. 2810 FORMAT (22X,A10,A10,1X,A8,4X,A10,2X,*LINE *,I3,
  391. * 3X,2A10)
  392. 2820 FORMAT (22X,*JOIN SEQUENCE *,A8,3X,*LINE *,I3)
  393. 2830 FORMAT (38X,A8,3X,*LINE *,I3)
  394. C
  395. C
  396. C
  397. C UNLABLED -OUTPUTL- DATA
  398. C
  399. 900 PRINT 2900
  400. II=LTH-1
  401. IF(II.LE.0)GOTO 915
  402. C
  403. DO 910 I=1,II
  404. N1=LINE(1+I)
  405. CALL VFORM (N1,V)
  406. N2=N1
  407. CALL IBFILL(N2)
  408. PRINT 2910,N2,N1,N1,V
  409. C
  410. 910 CONTINUE
  411. 915 PRINT 1004
  412. GOTO 10
  413. C
  414. 2900 FORMAT (3X,*OUTPUT-L*,11X,*NO OUTPUT LABEL*)
  415. 2910 FORMAT (22X,A10,2X,I10,3X,O20,3X,F10.4)
  416. * /--- BLOCK OUTPUTT 00 000 77/07/05 13.44
  417. C
  418. C
  419. C -OUTPUTT- COMMAND DATA
  420. C
  421. C LINE(5) IS THE INFO TYPE (LABEL) LIMITED TO
  422. C 7 CHARS MAX SPACE FILLED.
  423. C
  424. C THERE IS A NAME AND LESSON BUT NO AREA.
  425. C
  426. C LINE(6)-LINE(N) IS DISPLAYED IN -TEXT- FORMAT.
  427. C
  428. 1300 CALL IBFILL(LINE(5),NAME,NAME1,LESSON)
  429. PRINT 3300,LINE(5),NAME,NAME1,LESSON
  430. STARTL=6
  431. 1310 IF (STARTL.GT.LTH) GOTO 1390
  432. CALL FINDEOL(STARTL,ENDL)
  433. LINELTH=ENDL-STARTL+1
  434. TENDL=ENDL
  435. IF (LINELTH.GT.10) TENDL=STARTL+11
  436. CALL IBFILL(LINE(TENDL))
  437. IF (LINELTH.GT.1) CALL IBFILL(LINE(TENDL-1))
  438. PRINT 3310,(LINE(J),J=STARTL,TENDL)
  439. STARTL=ENDL+1
  440. GOTO 1310
  441. *
  442. 1390 PRINT 1004
  443. GOTO 10
  444. *
  445. *
  446. 3300 FORMAT(3X,A7,12X,A10,A8,3X,A10)
  447. 3310 FORMAT(22X,10A10)
  448. * /--- BLOCK END 00 000 80/02/01 00.46
  449. C
  450. C
  451. 90 PRINT 1003
  452. C
  453. C DETACH FILE AND RELEASE ALL ECS
  454. C
  455. 99 CALL DETACH
  456. CALL RELECS
  457. STOP
  458. C
  459. 1000 FORMAT (1H1)
  460. 1001 FORMAT (3X,11A10,//)
  461. 1002 FORMAT (3X,*DATA FILE *,A10,5X,*PRINTED AT*,A10,
  462. * * ON*,A10,//)
  463. 1003 FORMAT (//,3X,*+++++ END OF DATA +++++*)
  464. 1004 FORMAT (/)
  465. 1005 FORMAT (3X,5A10)
  466. 1006 FORMAT (3X,5A10,//)
  467. 1007 FORMAT (1HT)
  468. 1008 FORMAT (44X,4A10,1H*)
  469. 1009 FORMAT (44X,41(1H*))
  470. 1010 FORMAT (//)
  471. C
  472. END
  473. * /--- BLOCK ITOA 00 000 76/08/21 12.01
  474. SUBROUTINE ITOA (IIN,IOUT)
  475. C
  476. C
  477. C INTEGER TO ALPHA CONVERSION
  478. C
  479. C
  480. 1 IF(IIN.EQ.0)GOTO 50
  481. ENCODE (10,100,IOUT)IIN
  482. C
  483. 10 IF(((ISHL(IOUT,6)).AND.77B).NE.55B)GOTO 90
  484. IOUT=(ISHL(IOUT,6)).AND.(-77B)
  485. GOTO 10
  486. C
  487. 50 IOUT=1H0
  488. C
  489. 90 RETURN
  490. C
  491. 100 FORMAT (I10)
  492. C
  493. END
  494. SUBROUTINE FTOA (IIN,IOUT)
  495. C
  496. C
  497. C FLOATING POINT TO ALPHA CONVERSION
  498. C
  499. C
  500. 1 IF(IIN.EQ.0)GOTO 50
  501. ENCODE (10,100,IOUT)IIN
  502. I=0
  503. C
  504. 10 IF(((ISHR(IOUT,(I*6))).AND.77B).NE.1R0)GOTO 20
  505. IOUT=IOUT.AND.(ISHL((-77B),(I*6)))
  506. I=I+1
  507. IF(I.LT.3)GOTO 10
  508. C
  509. 20 IF(((ISHL(IOUT,6)).AND.77B).NE.55B)GOTO 90
  510. IOUT=(ISHL(IOUT,6)).AND.(-77B)
  511. GOTO 20
  512. C
  513. 50 IOUT=3H0.0
  514. C
  515. 90 RETURN
  516. C
  517. 100 FORMAT (F10.4)
  518. C
  519. END
  520. * /--- BLOCK SHIFTS 00 000 76/08/13 14.55
  521. IDENT SHIFTS
  522. *
  523. * FUNCTIONS FOR LEFT AND RIGHT SHIFTS.
  524. * CALLABLE FROM FTN.
  525. *
  526. * LAWRENCE A. WHITE
  527. * AUGUST 11, 1976
  528. *
  529. ENTRY ISHL
  530. ISHL EQ *+400000B
  531. SA2 X1 VALUE TO BE SHIFTED
  532. SA1 A1+1
  533. SA3 X1 AMOUNT TO SHIFT IT
  534. SB2 X3
  535. LX6 X2,B2
  536. EQ ISHL
  537. *
  538. ENTRY ISHR
  539. ISHR EQ *+400000B
  540. SA2 X1
  541. SA1 A1+1
  542. SA3 X1
  543. SB2 X3
  544. AX6 X2,B2
  545. EQ ISHR
  546. *
  547. *
  548. END
  549. * /--- BLOCK SETUP 00 000 80/05/17 19.42
  550. IDENT SETUP
  551. TITLE -SETUP-
  552. LIST X
  553. *CALL DPRTX
  554. *CALL SYSCON
  555. LIST *
  556. SST
  557. SYSCOM
  558. *
  559. TITLE LOAD TIME INITIALIZATIONS
  560. *
  561. * -SETUP-
  562. *
  563. ENTRY SETUP
  564. EXT REQECS,GETARG,ECSPRTY
  565.  
  566. SETUP EQ *
  567.  
  568.  
  569. * WRITE ACCOUNT, COURSE, NAME OF PRINT REQUESTOR
  570. * TO ACCOUNT FILE
  571.  
  572. MESSAGE CCDR,5,RECALL
  573.  
  574.  
  575. RJ GETARG GET THE FILE NAME
  576. SA6 FILE AND, SAVE
  577.  
  578. IFCDC IFEQ CDC,0
  579. IFCDC IFEQ CDC,0
  580. RJ GETARG GET SECOND CONTROL CARD ARG
  581. SA1 =4LHIGH SEE IF IT IS '7HIGH'7
  582. IX6 X1-X6
  583. IFCDC ELSE
  584. MX6 59
  585. ENDIF
  586. IFCDC ELSE
  587. MX6 59
  588. ENDIF
  589. SA6 PDEN STORE FOR FTN PROGRAM
  590.  
  591. SA1 65B NEXT AVAILABLE CM
  592. SX6 X1+100B ROUND UP BY 100B
  593. MX0 -6
  594. BX6 X0*X6
  595. LX6 30
  596. SA6 CMFL SET CM FIELD LENGTH
  597. MEMORY CM,CMFL,RECALL
  598. SX6 ECSLTH SET ECS FIELD LENGTH
  599. SA6 ECFL
  600. CALL REQECS,ECFL REQUEST ECS
  601. CLOCK TIME
  602. DATE DATE
  603. * /--- BLOCK SETUP 00 000 80/02/01 00.46
  604. *
  605. * LOOK FOR PRINT INFO IN DAYFILE. PASS TO FTN IN 1ST 20 WDS
  606. * OF *LINE* BUFFER. LINE(1) = 0 IF NOT THERE. USES *BUFF*
  607. * AS TEMP. STORAGE
  608. *
  609. CONTROL BUFF,1 GET CARD FOLLOWING DPRINT CARD
  610. SA1 BUFF
  611. SA2 =10L***** MAIL HEADER FOR MAILING INFO
  612. MX6 0 PRESET NOT THERE
  613. SA6 LINE
  614. IX1 X1-X2 SEE IF INFO IS THERE
  615. NZ X1,SETUP --- BRANCH IF NOT
  616. MX0 0 ECS XFER ADDRESS
  617. SX7 A0
  618. SA7 SAVEA0 SAVE FOR FTN
  619. SX5 A6 INITIAL CM TRANSFER ADDRESS
  620. PRINFO CONTROL BUFF GET A LINE OF INFO (8 WDS MAX)
  621. SA0 BUFF ONLY THE 1ST 4 WORDS ARE USED
  622. WE 4 MOVE IT WHERE IT BELONGS
  623. RJ ECSPRTY
  624. SA0 X5 X5,A0,X0 SAVED OVER SYS CALLS
  625. RE 4
  626. RJ ECSPRTY
  627. SX5 X5+4 ADDRESS OF NEXT LOCATION
  628. SB1 LINE+20 CANNOT DO SB1 X5-LINE-20
  629. SB2 X5 CUZ LOADER NO ALLOW
  630. LT B2,B1,PRINFO --- IF NOT DONE YET
  631. SA1 SAVEA0 RESTORE A0
  632. SA0 X1
  633. EQ SETUP
  634. *
  635. CMFL BSS 1
  636. ECFL BSS 1
  637. SAVEA0 BSS 1
  638. *
  639. END
  640. * /--- BLOCK GETLINE 00 000 76/10/16 00.27
  641. IDENT GETLINE
  642. TITLE READ DATA FILE
  643. *
  644. *CALL DPRTX
  645. *
  646. EXT DISKIN
  647. *
  648. TITLE -GETLINE- GET NEXT DATA RECORD
  649. *
  650. *
  651. * -GETLINE-
  652. * READS NEXT DATA RECORD TO *LINE*
  653. *
  654. *
  655. ENTRY GETLINE
  656. GETLINE EQ *
  657. SA1 NXT
  658. SB1 X1 B1 = POINTER TO NEXT WORD
  659. RJ ISTWORD
  660. BX6 X1 STORE HEADER WORD
  661. SA6 LINE
  662. MX0 -6 MASK FOR RECORD LENGTH
  663. AX1 6
  664. BX1 -X0*X1 MASK OFF RECORD LENGTH
  665. ZR X1,ENDFIL
  666. SB2 1 INDEX IN *LINE*
  667. SB3 X1 END TEST
  668. *
  669. GETLP GE B2,B3,ENDLIN
  670. RJ NXTWORD GET NEXT WORD OF DATA
  671. BX6 X1
  672. SA6 B2+LINE MOVE TO *LINE* BUFFER
  673. SB2 B2+1
  674. SB4 B2-64
  675. NG B4,GETLP
  676. EQ ENDFIL
  677. *
  678. ENDLIN SX6 B1
  679. SA6 NXT UPDATE WORD POINTER
  680. EQ GETLINE
  681. *
  682. *
  683. *
  684. * -NXTWORD-
  685. * GET NEXT WORD OF DATA RECORD
  686. *
  687. *
  688. NXTWORD EQ *
  689. SX1 B1-BLKLTH SEE IF AT END OF BUFFER
  690. PL X1,NXTW1
  691. SA1 B1+BUFF LOAD NEXT WORD
  692. SB1 B1+1 ADVANCE POINTER
  693. EQ NXTWORD
  694. *
  695. NXTW1 RJ NXTBLOK GET NEXT BLOCK
  696. EQ NXTWORD
  697. *
  698. *
  699. * /--- BLOCK GETLINE 00 000 77/01/20 16.30
  700. *
  701. * -ISTWORD-
  702. * GET FIRST WORD OF DATA RECORD
  703. *
  704. ISTWORD EQ *
  705. RJ NXTWORD GET NEXT WORD
  706. NZ X1,ISTWORD
  707. RJ NXTBLOK GET NEXT BLOCK
  708. EQ ISTWORD
  709. *
  710. *
  711. NXTBLOK EQ *
  712. SX6 B2 SAVE REGISTERS
  713. SA6 SAV1
  714. SX6 B3
  715. SA6 SAV2
  716. SA1 BLOCK BLOCK CURRENTLY ON
  717. SX7 X1+1
  718. SA7 A1 UPDATE BLOCK COUNT
  719. SA2 BLOCKS NUM FULL BLOCKS IN FILE
  720. IX2 X1-X2
  721. PL X2,ENDFIL JUMP IF END OF FULL BLOCKS
  722. SA2 TBLKS NUM OF TOTAL BLOCKS IN FILE
  723. IX2 X7-X2
  724. PL X2,ENDFIL JUMP IF END-OF-FILE
  725.  
  726. SX1 BLOCK BLOCK NUMBER FOR -DISKIN-
  727. CALL DISKIN
  728. SB1 1 RESET WORD POINTER
  729. SA1 SAV1
  730. SB2 X1 RESTORE B2
  731. SA1 SAV2
  732. SB3 X1 RESTORE B3
  733. SA1 BUFF LOAD NEXT WORD
  734. EQ NXTBLOK
  735. *
  736. ENDFIL MX6 -1 SET END-OF-FILE FLAG
  737. SA6 END
  738. MX6 0
  739. SA6 LINE CLEAR HEADER WORD
  740. EQ GETLINE
  741. *
  742. *
  743. TITLE -ISTLIN- INITIALIZATIONS
  744. *
  745. *
  746. * -ISTLIN-
  747. * INITIALIZE FOR -GETLINE-
  748. *
  749. *
  750. ENTRY ISTLIN
  751. ISTLIN EQ *
  752. SX6 1 INITIALIZE BLOCK COUNTER
  753. SA6 BLOCK
  754. SA1 BLOCKS
  755. NG X1,ISTEND
  756. ZR X1,ISTEND
  757. MX6 0
  758. SA6 END INITIALIZE END-OF-FILE FLAG
  759. SA6 NXT INITIALIZE WORD POINTER
  760. SX1 BLOCK BLOCK NUMBER FOR -DISKIN-
  761. CALL DISKIN
  762. EQ ISTLIN
  763. *
  764. ISTEND MX6 -1 MARK END-OF-FILE
  765. SA6 END
  766. EQ ISTLIN
  767. *
  768. *
  769. *
  770. SAV1 BSS 1
  771. SAV2 BSS 1
  772. *
  773. *
  774. END
  775. * /--- BLOCK DISKIN 00 000 80/02/01 00.46
  776. IDENT DISKIN
  777. TITLE -DISKIN-
  778. *
  779. *CALL DPRTX
  780. *
  781. EXT REQECS,OPF,CPF,READPF
  782. *
  783. TITLE ATTACH FILE
  784. *
  785. *
  786. * -ATTACH-
  787. * ATTACH SPECIFIED FILE
  788. *
  789. * ON ENTRY - X1 = ADDRESS OF FILE NAME
  790. *
  791. *
  792. ENTRY ATTACH
  793. ATTACH EQ *
  794. SA2 X1 GET FILE NAME
  795. BX6 X2
  796. SA6 PFILE
  797. CALL OPF,PFILE,READAC
  798. NZ X1,ATTERR ERROR CHECK
  799. EQ ATTACH
  800. *
  801. PFILE DATA 0 PLATO FILE NAME
  802. DATA 0 EOL
  803. *
  804. ATTERR MESSAGE ATTMES,0,RECALL
  805. MESSAGE PFILE,0,RECALL
  806. CALL RELECS RELEASE ALL ECS
  807. CALL DETACH
  808. ABORT
  809.  
  810. *
  811. TITLE DETACH PLATO FILE
  812. *
  813. *
  814. * -DETACH-
  815. * DETACH SPECIFIED FILE
  816. *
  817. *
  818. ENTRY DETACH,ECSPRTY
  819. DETACH EQ *
  820. CALL CPF,PFILE
  821. EQ DETACH
  822. *
  823. *
  824. TITLE READ BLOCK FROM PLATO DISK FILE
  825. *
  826. *
  827. * -DISKIN-
  828. * READS SPECIFIED BLOCK FROM DISK AND TRANSFERS
  829. * IT TO THE CM BUFFER *BUFF*
  830. *
  831. * ON ENTRY - X1 = ADDRESS OF BLOCK NUMBER
  832. *
  833. *
  834. ENTRY DISKIN
  835. DISKIN EQ *
  836. CALL READPF,PFILE,X1,DISKBUF
  837. NZ X1,DISKERR ERROR CHECK
  838. *
  839. SX6 A0 SAVE A0 FOR FTN
  840. SA6 A0SAVE
  841.  
  842. SX0 DISKBUF ADDRESS OF ECS BUFFER
  843. SA0 BUFF
  844. + RE BLKLTH BRING BLOCK TO CM
  845. RJ ECSPRTY
  846. SA1 A0SAVE RESTORE A0
  847. SA0 X1
  848. EQ DISKIN
  849. *
  850. DISKERR MESSAGE DISKMES,,RECALL
  851. MX6 0
  852. SA6 BUFF SET END-OF-FILE
  853. SA6 BUFF+1
  854. EQ DISKIN EXIT
  855. *
  856. ECSPRTY MESSAGE ECSMES,,RECALL
  857. CALL RELECS RELEASE ALL ECS
  858. CALL DETACH DETACH PLATO FILE
  859. ABORT
  860. *
  861. *
  862. ATTMES DIS ,*ATTACH ERROR*
  863. DISKMES DIS ,$**** DISK ERROR ****$
  864. ECSMES DIS ,$**** ECS ERROR ****$
  865. *
  866. A0SAVE DATA 0 FOR SAVING A0 FOR FTN
  867. IECS VFD 60/DISKBUF
  868. READAC DATA 4LREAD OPEN FILE WITH READ ACCESS
  869. *
  870. *
  871. * OPL XTEXT COMCSYS
  872. *
  873. END
  874. * /--- BLOCK ANSFORM 00 000 76/10/16 00.27
  875. IDENT FORMAT
  876. TITLE OUTPUT FORMATTING
  877. *
  878. *CALL DPRTX
  879. *
  880. *
  881. TITLE -ANSFORM-
  882. *
  883. *
  884. * -ANSFORM-
  885. * FORMAT STUDENT RESPONSE AND JUDGEMENT
  886. *
  887. *
  888. ENTRY ANSFORM
  889. ANSFORM EQ *
  890. SX1 =1H BLANK FILL *OUTBUF*
  891. CALL FILL
  892. SA1 LTH
  893. SB2 X1-6 LENGTH OF STUDENT RESPONSE
  894. SB1 B2-10
  895. NG B1,ANSF1 JUMP IF ANSWER NOT TOO LONG
  896. SB2 10
  897. *
  898. ANSF1 SB1 B0 INITIALIZE INDEX
  899. *
  900. AFLP GE B1,B2,ANSF2
  901. SA1 B1+LINE+6 LOAD NEXT WORD OF ANSWER
  902. BX6 X1
  903. SA6 B1+OUTBUF MOVE TO OUTPUT BUFFER
  904. SB1 B1+1
  905. EQ AFLP
  906. *
  907. ANSF2 MX0 -4*6 4 CHARACTER MASK
  908. SA2 BLANK4
  909. NZ B1,ANSF3 CHECK FOR ZERO LTH ANSWER
  910. SB1 1
  911. EQ ANSF4
  912. *
  913. ANSF3 SA1 B1+OUTBUF-1
  914. BX1 -X0*X1 MASK OFF BOTTOM 4 CHARS
  915. ZR X1,ANSF4
  916. BX0 X1-X2 SEE IF BLANK
  917. ZR X0,ANSF4
  918. SB1 B1+1 ADVANCE TO NEXT WORD
  919. *
  920. * /--- BLOCK ANSFORM 00 000 74/03/20 14.42
  921. *
  922. ANSF4 MX7 -6
  923. SA1 LINE LOAD HEADER WORD
  924. LX1 18+6 POSITION JUDGEMENT TYPE
  925. BX1 -X7*X1
  926. SA3 X1+JMENT-1 LOAD JUDGEMENT HOLLERITH
  927. MX7 6
  928. SA1 B1+OUTBUF-1 LOAD LAST WORD
  929. SA2 =1L
  930. SB2 60-24 INITIALIZE SHIFT COUNT
  931. *
  932. AFLP1 BX0 X7*X1 MASK OFF NEXT CHARACTER
  933. ZR X0,ANSF5
  934. BX0 X0-X2 SEE IF BLANK
  935. ZR X0,ANSF5
  936. SB2 B2-6
  937. LX7 60-6 RE-POSITION MASK
  938. LX2 60-6 RE-POSITION BLANK
  939. EQ AFLP1
  940. *
  941. ANSF5 MX7 -4*6 MASK FOR 4 CHARACTERS
  942. LX7 X7,B2 POSITION MASK
  943. BX7 X7*X1
  944. LX3 X3,B2 POSITION JUDGEMENT
  945. BX7 X3+X7
  946. SA7 A1 STORE WITH JUDGEMENT ATTACHED
  947. EQ ANSFORM
  948. *
  949. *
  950. JMENT VFD 36/0,24/4L OK
  951. + VFD 36/0,24/4L NO
  952. + VFD 36/0,24/4L NO
  953. *
  954. BLANK4 VFD 36/0,24/4L
  955. *
  956. *
  957. * /--- BLOCK OUTFORM 00 000 76/08/21 13.19
  958. TITLE -OUTFORM-
  959. *
  960. *
  961. * -OUTFORM-
  962. * FORMAT -OUTPUT- COMMAND DATA
  963. *
  964. *
  965. ENTRY OUTFORM
  966. OUTFORM EQ *
  967. SX1 =1H BLANK FILL *OUTBUF*
  968. CALL FILL
  969. MX0 -6
  970. SA1 LINE LOAD HEADER WORD
  971. LX1 6
  972. BX2 -X0*X1 MASK OFF NUMBER OF ENTRIES
  973. ZR X2,OUTFORM
  974. LX1 6
  975. BX1 -X0*X1 MASK OFF LENGTH OF TABLE
  976. SX6 X1+5 ADDRESS OF START OF DATA
  977. SA6 IDAT
  978. SX1 X2-21 CHECK NUMBER OF ENTRIES
  979. NG X1,OUTF1
  980. SX2 20 MAXIMUM OF 20 ENTRIES
  981. *
  982. OUTF1 SB3 X2 END TEST
  983. MX0 -12 MASK FOR ONE TABLE ENTRY
  984. SB1 B0 INITIALIZE INDEX
  985. SB2 B0
  986. *
  987. OFLP SA1 B1+LINE+5 LOAD NEXT WORD OF TABLE
  988. SB1 B1+1
  989. SB4 5 5 TABLE ENTRIES/WORD
  990. *
  991. OFLP1 LX1 12 POSITION NEXT TABLE ENTRY
  992. BX6 -X0*X1
  993. SA6 B2+ITABLE
  994. SB2 B2+1 ADVANCE TABLE INDEX
  995. GE B2,B3,OUTF2
  996. SB4 B4-1 SEE IF AT END OF WORD
  997. NZ B4,OFLP1
  998. EQ OFLP GET NEXT WORD
  999. *
  1000. * /--- BLOCK OUTFORM 00 000 74/03/20 14.43
  1001. *
  1002. OUTF2 MX6 -1 SET TABLE END TEST
  1003. SA6 B2+ITABLE
  1004. MX6 0
  1005. SA6 TINDX INITIALIZE INDEX IN TABLE
  1006. SA6 IINDX INITIALIZE CHARACTER INDEX
  1007. *
  1008. OUTFLP SA1 TINDX CURRENT INDEX IN TABLE
  1009. SX6 X1+1
  1010. SA6 A1
  1011. MX0 -6
  1012. SA1 X1+ITABLE LOAD CURRENT TABLE ENTRY
  1013. NG X1,PACKUP
  1014. BX2 -X0*X1 MASK OFF LENGTH OF DATA
  1015. ZR X2,OUTFLP
  1016. AX1 6
  1017. BX1 -X0*X1 MASK OFF DATA TYPE (A,N,O,V)
  1018. SB1 X1
  1019. JP B1+*+1 JUMP BY DATA TYPE
  1020. *
  1021. + EQ OFALPHA ALPHA
  1022. + EQ OFINT INTEGER
  1023. + EQ OFOCT OCTAL
  1024. + EQ OFFLT FLOATING
  1025. *
  1026. *
  1027. * FORMAT ALPHA DATA
  1028. *
  1029. OFALPHA SB1 X2 SAVE LENGTH OF DATA ENTRY
  1030. *
  1031. OFALP SA1 IDAT POINTER TO NEXT WORD OF DATA
  1032. SX6 X1+1
  1033. SA6 A1
  1034. SA1 X1+LINE LOAD NEXT WORD OF DATA
  1035. ZR X1,OFALP2
  1036. MX0 6
  1037. *
  1038. OFALP1 BX2 X0*X1 MASK OFF NEXT CHARACTER
  1039. NZ X2,OFALP2
  1040. LX1 6 LEFT JUSTIFY
  1041. EQ OFALP1
  1042. *
  1043. * /--- BLOCK OUTFORM 00 000 76/08/21 12.48
  1044. *
  1045. OFALP2 CALL OPEN
  1046. SB1 B1-1 END TEST
  1047. ZR B1,OUTFLP
  1048. NG B1,OUTFLP
  1049. EQ OFALP
  1050. *
  1051. *
  1052. * FORMAT INTEGER DATA
  1053. *
  1054. OFINT SA1 IDAT POINTER TO NEXT WORD OF DATA
  1055. SX6 X1+1
  1056. SA6 A1
  1057. SX6 X1+LINE SET UP FOR CALL
  1058. SA6 ARGS
  1059. SX6 ITEMP
  1060. SA6 A6+1
  1061. SA1 ARGS
  1062. CALL ITOA CONVERT TO ALPHA
  1063. SA1 ITEMP
  1064. CALL OPEN
  1065. EQ OUTFLP
  1066. *
  1067. *
  1068. * FORMAT OCTAL DATA
  1069. *
  1070. OFOCT SA1 IDAT POINTER TO NEXT WORD OF DATA
  1071. SX6 X1+1
  1072. SA6 A1
  1073. SB1 X1+LINE SET UP FOR CALL
  1074. SB2 ITEMP
  1075. CALL OTOA CONVERT TO ALPHA
  1076. SA1 ITEMP
  1077. CALL OPEN
  1078. SA1 ITEMP1
  1079. CALL OPEN
  1080. EQ OUTFLP
  1081. *
  1082. *
  1083. * FORMAT FLOATING POINT DATA
  1084. *
  1085. OFFLT SA1 IDAT POINTER TO NEXT WORD OF DATA
  1086. SX6 X1+1
  1087. SA6 A1
  1088. SX6 X1+LINE SET UP FOR CALL
  1089. SA6 ARGS
  1090. SX6 ITEMP
  1091. SA6 A6+1
  1092. SA1 ARGS
  1093. CALL FTOA CONVERT TO ALPHA
  1094. SA1 ITEMP
  1095. CALL OPEN
  1096. EQ OUTFLP
  1097. *
  1098. * /--- BLOCK OUTFORM 00 000 74/03/20 14.45
  1099. *
  1100. PACKUP SA1 IINDX POINTER TO NEXT CHARACTER
  1101. MX6 0
  1102. SA6 X1+IOPEN END TEST
  1103. SB1 B0
  1104. SB2 B0
  1105. *
  1106. PACKLP SB3 60-6 INITIALIZE SHIFT COUNT
  1107. MX6 0
  1108. *
  1109. PACKLP1 SA1 B1+IOPEN LOAD NEXT CHARACTER
  1110. ZR X1,PACKED JUMP IF END OF STRING
  1111. SB1 B1+1
  1112. LX1 X1,B3
  1113. BX6 X1+X6 MERGE WITH WORD BUILDING
  1114. SB3 B3-6
  1115. PL B3,PACKLP1
  1116. SA6 B2+OUTBUF STORE COMPLETED WORD
  1117. SB2 B2+1
  1118. EQ PACKLP
  1119. *
  1120. PACKED SA6 B2+OUTBUF STORE LAST WORD
  1121. EQ OUTFORM
  1122. *
  1123. *
  1124. *
  1125. * -OPEN-
  1126. * OPEN NEXT WORD OF DATA (IN X1) TO *IOPEN*
  1127. *
  1128. *
  1129. OPEN EQ *
  1130. MX0 -6
  1131. SA2 IINDX CHARACTER POINTER IN *IOPEN*
  1132. *
  1133. OPLP LX1 6
  1134. BX6 -X0*X1 (X6) = NEXT CHARACTER
  1135. ZR X6,OPN1 IF NULL CHARACTER
  1136. SA6 X2+IOPEN
  1137. SX2 X2+1 INCREMENT INDEX
  1138. SX6 X2-100
  1139. PL X6,OPN2 IF BUFFER IS FULL
  1140.  
  1141. OPN1 BX1 X0*X1 CLEAR CHARACTER
  1142. NZ X1,OPLP IF MORE CHARACTERS
  1143. SX6 X2 UPDATE INDEX
  1144. SA6 IINDX
  1145. EQ OPEN
  1146.  
  1147. OPN2 SX6 X2-1 UPDATE INDEX
  1148. SA6 IINDX
  1149. EQ OPEN
  1150. *
  1151. * /--- BLOCK OTOA 00 000 76/08/13 14.57
  1152. TITLE OCTAL TO ALPHA CONVERSION
  1153. *
  1154. *
  1155. * -OTOA-
  1156. * OCTAL TO ALPHA CONVERSION
  1157. *
  1158. * ON ENTRY - B1 = ADDRESS OF WORD TO CONVERT
  1159. * B2 = WHERE TO PUT 2 WORD OUTPUT
  1160. *
  1161. *
  1162. ENTRY OTOA
  1163. OTOA EQ *
  1164. MX0 -3
  1165. SA1 B1 LOAD WORD TO CONVERT
  1166. SB3 2 END TEST - OUTPUT 2 WORDS
  1167. *
  1168. OLP1 SB1 54 INITIALIZE SHIFT COUNT
  1169. MX6 0
  1170. *
  1171. OLP2 LX1 3 POSITION NEXT OCTAL PLACE
  1172. BX2 -X0*X1
  1173. SX2 X2+1R0 CONVERT TO ALPHA
  1174. LX2 X2,B1
  1175. BX6 X2+X6 MERGE WITH REST OF WORD
  1176. SB1 B1-6
  1177. PL B1,OLP2 JUMP IF WORD NOT DONE
  1178. *
  1179. OLP3 SA6 B2 STORE COMPLETED WORD
  1180. SB3 B3-1
  1181. ZR B3,OTOA END TEST
  1182. SB2 B2+1
  1183. EQ OLP1
  1184. *
  1185. *
  1186. TITLE -VFORM-
  1187. *
  1188. *
  1189. ENTRY VFORM
  1190. VFORM EQ *
  1191. SA2 X1
  1192. BX6 X2
  1193. SA1 A1+1
  1194. SA6 X1
  1195. EQ VFORM
  1196. *
  1197. *
  1198. * /--- BLOCK FILL 00 000 76/08/21 10.12
  1199. TITLE -FILL- FILL -OUTBUF-
  1200. *
  1201. *
  1202. * -FILL-
  1203. * ON ENTRY - X1 = ADDRESS OF WORD TO FILL WITH
  1204. *
  1205. *
  1206. ENTRY FILL
  1207. FILL EQ *
  1208. SB2 10
  1209. SA2 X1 LOAD FILL WORD
  1210. BX6 X2
  1211. *
  1212. FLP SA6 B2+OUTBUF
  1213. SB2 B2-1
  1214. PL B2,FLP
  1215. EQ FILL
  1216. *
  1217. *
  1218. ITEMP BSS 2
  1219. ITEMP1 EQU ITEMP+1
  1220. *
  1221. IDAT BSS 1
  1222. IINDX BSS 1
  1223. TINDX BSS 1
  1224. ITABLE BSS 20+1 ALLOW 20 DATA ENTRIES
  1225. IOPEN BSS 100+1 ALLOW 100 CHARACTERS
  1226. ARGS BSS 2 ADDRESS OF 2 ARGUMENTS FOR A
  1227. * FTN SUBROUTINE
  1228. DATA 0 END OF ARGS FLAG
  1229. *
  1230. *
  1231. END
  1232. * /--- BLOCK BLANKFILL 00 000 76/08/21 09.47
  1233. IDENT BLFILL
  1234. TITLE ZERO TO BLANK ROUTINE
  1235. *
  1236. * -IBFILL-
  1237. *
  1238. * BLANK FILL ALL ARGUMENTS
  1239. * CALLABLE FROM FTN. CALL IBFILL(I,J,K,L,M,N)
  1240. * CONVERTS ALL 00B CHARS TO 55B
  1241. *
  1242. ENTRY IBFILL
  1243. IBFILL EQ *
  1244. SB1 1
  1245. FILLLP ZR X1,IBFILL END OF ARGUMENTS CHECK
  1246. SA5 X1 GET ARGUMENT
  1247. RJ BLFILL BLANK FILL
  1248. SA6 X1 RE-STORE BLANK FILLED VERSION
  1249. SA1 A1+1 GET ADDRESS OF NEXT ARGUMENT
  1250. EQ FILLLP GO FILL IT
  1251.  
  1252. *
  1253. * -IBFILLB-
  1254. *
  1255. * BLANK FILL A BUFFER (CALLABLE FROM FTN)
  1256. *
  1257. * CALL IBFILLB(BUFFER,NWORDS)
  1258. * BLANK FILLS *BUFFER* THROUGH *BUFFER+NWORDS-1*
  1259. *
  1260. ENTRY IBFILLB
  1261. IBFILLB EQ *
  1262. SB1 1
  1263. SA5 X1 GET FIRST WORD OF BUFFER
  1264. SA1 A1+1 GET ADDRESS OF NUMBER WORDS
  1265. SA1 X1 GET NUMBER WORDS
  1266. FILLBLP RJ BLFILL BLANK FILL WORD
  1267. SA6 A5 RE-STORE
  1268. SX1 X1-1 DECREMENT WORD COUNTER
  1269. ZR X1,IBFILLB ALL FILLED, ---RETURN
  1270. SA5 A5+1 GET NEXT WORD
  1271. EQ FILLBLP
  1272.  
  1273. *
  1274. * ENTRY X5 = 10 CHARACTER WORD
  1275. * EXIT X6 = SAME THING WITH 6/55B IN PLACE OF 6/0.
  1276. *
  1277. BLFILL PS
  1278. SA2 =40404040404040404040B
  1279. BX3 -X5
  1280. LX4 B1,X3
  1281. BX3 X3*X4
  1282. LX4 1
  1283. BX3 X3*X4
  1284. BX4 X3
  1285. LX4 3
  1286. BX3 X3*X4
  1287. BX3 X3*X2
  1288. BX4 X3
  1289. LX4 -2
  1290. BX3 X3+X4
  1291. BX4 X3
  1292. LX4 -3
  1293. BX3 X3+X4
  1294. BX6 X5+X3
  1295. EQ BLFILL
  1296. *
  1297. END
  1298. * /--- BLOCK FINDEOL 00 000 77/07/03 00.36
  1299. IDENT FINDEOL
  1300. TITLE FIND END OF LINE
  1301. *
  1302. *CALL DPRTX
  1303. *
  1304. *
  1305. ENTRY FINDEOL
  1306. *
  1307. * FIND END OF TEXT LINE
  1308. * (FTN CALLABLE)
  1309. * ON ENTRY - A1 = ADDRESS OF ARGUMENT ADDRESSES
  1310. * 1ST ARGUMENT = STARTING WORD NUMBER (INDEX
  1311. * INTO ARRAY *LINE*)
  1312. *
  1313. * ON EXIT - 2ND ARGUMENT = END WORD NUMBER (INDEX)
  1314. *
  1315. FINDEOL PS
  1316. MX0 -12 MASK FOR E-O-L TEST
  1317. SB7 1 FOR INCREMENT
  1318. SA2 X1 STARTING INDEX IN X1
  1319. SA2 X2+LINDEX-1
  1320. *
  1321. GLOOP SA2 A2+B7 GET NEXT WORD
  1322. BX2 -X0*X2 LOOK AT BOTTOM 12 BITS
  1323. NZ X2,GLOOP LOOK SOME MORE IF NON-ZERO
  1324. *
  1325. SX6 A2
  1326. SX7 LINDEX
  1327. IX6 X6-X7 CONVERT TO FORTRAN INDEX
  1328. SA1 A1+1 GET ADDRESS OF ARGUMENT
  1329. SA6 X1 STORE IN RETURN LOCATION
  1330. EQ FINDEOL AND RETURN
  1331. *
  1332. LINDEX EQU LINE-1
  1333. *
  1334. END
plato.source/plaopl/dprt.txt ยท Last modified: 2021/02/06 16:22 by 127.0.0.1