CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:accprt

ACCPRT

Table Of Contents

  • [00221] SUBROUTINES FOR ACCOUNT FILES PRINTER
  • [00222] DEFINITIONS
  • [00274] MACROS
  • [00290] -SETUP- LOAD TIME INITIALIZATIONS
  • [00376] SYSTEXT
  • [00385] *MASTOR* REQUEST/COMMUNICATION ROUTINES
  • [00392] RETURN PROPER FILE TYPE
  • [00438] -NOTYPES- ARGUMENT ERROR IN CONTROL CARD
  • [00447] SHIFTS
  • [00475] ZERO TO BLANK ROUTINE
  • [00519] ATTACH PLATO FILE
  • [00556] BOMBOFF IF NOT AN ACCOUNT
  • [00574] DETACH PLATO FILE
  • [00587] READ BLOCK FROM PLATO DISK FILE
  • [00621] STORAGE

Source Code

ACCPRT.txt
  1. ACCPRT
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK FILES PRT 00 000 81/01/28 15.49
  4. OVERLAY(AFPRINT,0,0)
  5. PROGRAM AFPRT(INPUT,OUTPUT)
  6. C
  7. C COMMON DEFINITIONS
  8. C
  9. IMPLICIT INTEGER(A-Z)
  10. C
  11. REAL TEMP,TEMP1
  12. C
  13. DIMENSION FNAMES(2000),FIWS(2000),NFILES(17),NPARTS(17)
  14. C
  15. COMMON /ARGS/ ACCOUNT,PACCT,PGROUP,PNAME,FTYPES
  16. C
  17. COMMON /DISK/ FIW,DISKADD,DISKF1,DISKF2,BUFF(320)
  18. C
  19. COMMON /DATIME/ TIME,DATE
  20. C
  21. DATA NFILES/17*0/,NPARTS/17*0/
  22. C
  23. C
  24. C INITIALIZATIONS
  25. C
  26. C
  27. CALL SETUP
  28. ACCT=ACCOUNT
  29. CALL IBFILL(ACCT)
  30. C
  31. C GET THE DIRECTORY INFO
  32. C
  33. CALL ATTACH (ACCOUNT)
  34. TYPE=ISHR(FIW,30).AND.77B
  35. IF (TYPE.EQ.12)GOTO 05
  36. CALL BADFILE
  37. C
  38. 05 IF (FTYPES.NE.0) GOTO 06
  39. CALL NOTYPES
  40. C
  41. 06 CALL DISKIN (1)
  42. BLOCK=1
  43. C
  44. C --------
  45. C // NOTE - IF ACCOUNT DIRECTORY CHANGES, YOU MUST
  46. C // CHANGE THESE REFERENCES ALSO.
  47. C //
  48. C // *FPTR* = START OF FILE NAME TABLE
  49. C // *FTBLTH* = LENGTH OF FILE NAME TABLE
  50. C --------
  51. C
  52. FPTR=BUFF(13)
  53. FTBLTH=BUFF(22)
  54. FUSED=BUFF(1).AND.777777B
  55. FALLOT=ISHR(BUFF(1),18).AND.777777B
  56. PRINT 1000
  57. DO 10 I=1,11
  58. BUFF(I)=10L**********
  59. 10 CONTINUE
  60. CALL IBFILL(PGROUP,PNAME)
  61. PRINT 1010,(BUFF(I),I=1,11)
  62. PRINT 1020,ACCT,DATE,TIME,PNAME,PGROUP
  63. PRINT 1025,FTBLTH,FUSED,FALLOT
  64. DO 110 I=1,11
  65. BUFF(I)=10L**********
  66. 110 CONTINUE
  67. PRINT 1010,(BUFF(I),I=1,11)
  68. C
  69. IF (FTYPES.EQ.-1) GOTO 120
  70. PRINT 1011
  71. C
  72. DO 11 I=1,13
  73. J=ISHL(FTYPES,I).AND.1
  74. IF (J.EQ.0)GOTO 11
  75. J=FILETYP(I)
  76. PRINT 1012,J
  77. 11 CONTINUE
  78. C
  79. 120 PRINT 1000
  80. C
  81. C DETERMINE 1ST AND LAST BLOCK IN WHICH ACCOUNT
  82. C FILE NAME TABLE EXISTS, AND READ THAT INTO THE
  83. C FILE NAMES BUFFER
  84. C
  85. C SBLK=INT((FPTR-1)/320)+1 $$ STUPID -FTN-
  86. TEMP=((FPTR-1)/320)+1
  87. SBLK=INT(TEMP)
  88. C ENDBLK=INT(((FPTR+FTBLTH)-1)/320)+1 $$ STUPID -FTN-
  89. TEMP1=(((FPTR+FTBLTH)-1)/320)+1
  90. ENDBLK=INT(TEMP1)
  91. TFILES=0
  92. C
  93. C -- *START* SET TO (WHATEVER)+1 BECAUSE *FPTR* REFERENCES
  94. C -- FNAMES(0). WHOEVER DID THIS SHOULD BE SHOT.
  95. START=FPTR-((SBLK-1)*320)+1
  96. C
  97. C -- CATCH THE CASE WHICH IS IF *FPTR* DOES NOT LIE IN
  98. C -- BLOCK 1...
  99. C
  100. IF (SBLK.EQ.BLOCK)GOTO 12
  101. BLOCK=SBLK
  102. CALL DISKIN (SBLK)
  103. C
  104. 12 DO 100 K=SBLK,ENDBLK
  105. IF (BLOCK.EQ.K)GOTO 15
  106. C CALL ATTACH (ACCOUNT)
  107. CALL DISKIN (K)
  108. C CALL DETACH (ACCOUNT)
  109. START=1
  110. 15 CONTINUE
  111. ENDF=320
  112. IF (K.NE.ENDBLK)GOTO 20
  113. ENDF=(FPTR+FTBLTH)-((K-1)*320)
  114. 20 CONTINUE
  115. * /--- BLOCK FILES PRT 00 000 81/01/30 17.22
  116. DO 25 N=START,ENDF
  117. CALL ATTACH (BUFF(N))
  118. I=ISHR(FIW,30).AND.77B
  119. I=ISHL(FTYPES,I).AND.1
  120. CALL DETACH (BUFF(N))
  121. IF (I.NE.1) GOTO 25
  122. TFILES=TFILES+1
  123. FNAMES(TFILES)=BUFF(N)
  124. FIWS(TFILES)=FIW
  125. 25 CONTINUE
  126. 100 CONTINUE
  127. C
  128. C NOW, PRINT THE FILE NAMES AND CORRESPONDING INFO
  129. C
  130. IF (TFILES.GT.0) GOTO 35
  131. PRINT 1035
  132. GOTO 99
  133. C
  134. 35 I=1
  135. J=MIN0(58,TFILES)
  136. PAGE=0
  137. 45 K=0
  138. PAGE=PAGE+1
  139. PRINT 1026,ACCT,TIME,DATE,PAGE
  140. DO 50 N=I,J
  141. M=N+58
  142. CALL IBFILL (FNAMES(N))
  143. LENGTH1=ISHR(FIWS(N),24).AND.77B
  144. TYPE1=ISHR(FIWS(N),30).AND.77B
  145. NFILES(TYPE1)=NFILES(TYPE1)+1
  146. NPARTS(TYPE1)=NPARTS(TYPE1)+LENGTH1
  147. TYPE1=FILETYP(TYPE1)
  148. C
  149. C IF *M* .GT. THE TOTAL NUMBER OF FILES, ONLY
  150. C PRINT ONE PIECE OF FILE INFO PER LINE...
  151. C
  152. IF (M.GT.TFILES)GOTO 55
  153. C
  154. C ELSE PRINT 2 FILES PER LINE
  155. C
  156. C *FNAMES(M)* = BLANK-FILLED FILE NAME
  157. C *TYPE2* = 10 CHAR FILE TYPE
  158. C *LENGTH2* = LENGTH OF FILE IN *SYS(DSBLKS)*
  159. C
  160. CALL IBFILL (FNAMES(M))
  161. LENGTH2=ISHR(FIWS(M),24).AND.77B
  162. TYPE2=ISHR(FIWS(M),30).AND.77B
  163. NFILES(TYPE2)=NFILES(TYPE2)+1
  164. NPARTS(TYPE2)=NPARTS(TYPE2)+LENGTH2
  165. TYPE2=FILETYP(TYPE2)
  166. K=K+2
  167. PRINT 1040,FNAMES(N),LENGTH1,TYPE1,FNAMES(M),LENGTH2,TYPE2
  168. GOTO 50
  169. 55 PRINT 1030,FNAMES(N),LENGTH1,TYPE1
  170. K=K+1
  171. C
  172. 50 CONTINUE
  173. I=I+K
  174. J=MIN0(I+57,TFILES)
  175. PRINT 1000
  176. IF (I.LE.TFILES)GOTO 45
  177. C
  178. C NOW PRINT OUT ACCOUNT SUMMARY
  179. C
  180. PAGE=PAGE+1
  181. PRINT 1026,ACCT,TIME,DATE,PAGE
  182. K=0
  183. N=0
  184. PRINT 1050
  185. DO 65 I=1,17
  186. IF (NFILES(I).EQ.0) GOTO 65
  187. J=FILETYP(I)
  188. K=K+NFILES(I)
  189. N=N+NPARTS(I)
  190. PRINT 1055,J,NFILES(I),NPARTS(I)
  191. 65 CONTINUE
  192. PRINT 1060,K,N
  193. 99 CONTINUE
  194. * /--- BLOCK FILES PRT 00 000 78/10/07 00.46
  195. C ******************************************************
  196. C
  197. C VARIOUS -FORMAT- STATEMENTS
  198. C
  199. 1000 FORMAT (1H1)
  200. 1010 FORMAT (6X,11A10,//)
  201. 1011 FORMAT (6X,*FILE TYPES REQUESTED -*,/)
  202. 1012 FORMAT (12X,A10)
  203. 1020 FORMAT (6X,*FILES IN ACCOUNT *,A10,4X,*PRINTED ON*,A9,
  204. * 2X,*AT *,A6,4X,*BY *,A10,* OF GROUP *,A10,//)
  205. 1025 FORMAT (6X,*TOTAL FILES IN ACCOUNT = *,I4,8X,
  206. * *SPACES USED/ALLOTTED*,5X,I4,* / *,I4,//)
  207. 1026 FORMAT (6X,*LIST OF FILES FOR ACCOUNT *,A7,* AT*,A6,* ON*,
  208. * A10,45X*PAGE*,I5,/)
  209. 1030 FORMAT (6X,A10,4X,I2,* PART *,A10)
  210. 1035 FORMAT (6X,*NO FILES OF SPECIFIED TYPE(S)*)
  211. 1040 FORMAT (6X,A10,4X,I2,* PART *,A10,15X,
  212. * A10,4X,I2,* PART *,A10)
  213. 1050 FORMAT (//,20X,*ACCOUNT SPACE UTILIZATION SUMMARY*,///,15X,
  214. * * TYPE*,8X,*TOTAL FILES*,6X,*TOTAL PARTS*,//)
  215. 1055 FORMAT (15X,A10,7X,I4,12X,I5)
  216. 1060 FORMAT (/,14X,*GRAND TOTAL*,6X,I5,12X,I5)
  217. STOP
  218. END
  219. * /--- BLOCK IDENT 00 000 78/12/01 21.54
  220. IDENT FILESUB
  221. TITLE SUBROUTINES FOR ACCOUNT FILES PRINTER
  222. TITLE DEFINITIONS
  223. * ************************************************
  224. *
  225. *
  226. BLKLTH EQU 320 SIZE OF A PLATO DISK BLOCK
  227. ACSTART EQU 1 1ST BLOCK OF ACCOUNT
  228. ACCBLKS EQU 16 TOTAL BLKS IN AN ACCOUNT
  229. *
  230. *
  231. DISKBUF EQU 0
  232. ECSLTH EQU DISKBUF+BLKLTH
  233. *
  234. *
  235. USE /ARGS/
  236. ACCOUNT BSS 1 ACCOUNT NAME
  237. PACCT BSS 1 ACCOUNT OF PERSON DOING PRINT
  238. PGROUP BSS 1 GROUP OF PERSON DOING PRINT
  239. PNAME BSS 1 NAME OF PERSON DOING PRINT
  240. FTYPES BSS 1 FILE TYPES TO PRINT FLAGS
  241. *
  242. *
  243. USE /DISK/
  244. FIW BSS 1 FIW OF FILE OPENED
  245. DISKADD BSS 1 DISK ADDRESS OF FILE
  246. DISKF1 BSS 1
  247. DISKF2 VFD 48/BLKLTH,12/1
  248. BUFF BSS BLKLTH
  249. *
  250. *
  251. USE /DATIME/
  252. TIME BSS 1
  253. DATE BSS 1
  254. *
  255. USE
  256. *
  257. * ************************************************
  258. *
  259. *
  260. * FORMAT OF THE FILE INFORMATION WORD
  261. *
  262. *
  263. * 1ST BIT = FBIT - FILE CHANGED BIT
  264. * NEXT 11 = STATION FILE ATTACHED TO
  265. * NEXT 6 = RECORD MANAGEMENT TABLE
  266. * NEXT 6 = NUMBER OF DIRECTORY BLKS
  267. * NEXT 6 = FILE TYPE
  268. * NEXT 6 = LENGTH GIVEN IN *SYS(DSBLKS)*
  269. * NEXT 24 = DISK SPACE NUMBER
  270. *
  271. *
  272. * ************************************************
  273. * /--- BLOCK MACARONI 00 000 78/07/03 03.19
  274. TITLE MACROS
  275. * ************************************************
  276. *
  277. PURGMAC CALL
  278. CALL MACRO NAME,ARG1,ARG2,ARG3
  279. IFC NE,**ARG3*,1
  280. SB3 ARG3
  281. IFC NE,**ARG2*,1
  282. SB2 ARG2
  283. IFC NE,**ARG1*,1
  284. SB1 ARG1
  285. RJ =X_NAME_
  286. ENDM
  287. *
  288. * ************************************************
  289. * /--- BLOCK SETUP 00 000 80/05/17 21.02
  290. TITLE -SETUP- LOAD TIME INITIALIZATIONS
  291. **
  292. * PROGRAM INITIALIZATIONS
  293. *
  294. SST
  295. SYSCOM
  296. *CALL SYSCON
  297. *CALL COMCSYS
  298. *
  299. ENTRY SETUP
  300. SETUP EQ *
  301. CALL GETARG NAME OF ACCOUNT TO PRINT
  302. NZ X6,SETUP01 IF THIS IS 0, SUMTHING IS WRONG
  303. SA6 -1
  304. SETUP01 SA6 ACCOUNT
  305. CALL GETARG ACCT OF PERSON DOING PRINT
  306. SA6 PACCT
  307. CALL GETARG GROUP OF PERSON DOING PRINT
  308. SA6 PGROUP
  309. CALL GETARG NAME OF PERSON DOING PRINT
  310. SA6 PNAME
  311. *
  312. MX6 0 PRE-SET *FTYPES*
  313. SA6 FTYPES
  314. SETUP1 CALL GETARG
  315. ZR X6,SETUP2 DONE WITH CONTROL CARD
  316. LX6 18 RIGHT-JUSTIFY IF - ALL -
  317. SX4 X6-3RALL
  318. *
  319. NZ X4,SETUP15
  320. MX6 59 IF - ALL - SET ALL GOOD BITS
  321. EQ SETUP16
  322. *
  323. SETUP15 AX6 12 RIGHT-JUSTIFY SINGLE CHAR
  324. MX1 54 ISOLATE BOTTOM CHAR ONLY
  325. BX6 -X1*X6
  326. SX4 X6-1RM CHECK TO SEE IF VALID FTYPE
  327. PL X4,BADONE
  328. SB1 X6-60 FIND SHIFT CNT
  329. SX6 1
  330. AX6 X6,B1 MOVE TO PROPER LOCATION
  331. SA1 FTYPES GET CURRENT *FTYPES*
  332. BX6 X1+X6
  333. SETUP16 SA6 FTYPES AND STORE *FTYPES*
  334. EQ SETUP1
  335. *
  336. BADONE MESSAGE BADTYPE,,RECALL
  337. CALL RELECS
  338. ABORT
  339. *
  340. *
  341. SETUP2 SA1 LWPR LAST WORD OF PROGRAM
  342. SX6 X1+100B ROUND UP BY 100B
  343. MX0 -6
  344. BX6 X0*X6
  345. LX6 30
  346. SA6 CMFL SET CM FIELD LENGTH
  347. MEMORY CM,CMFL,RECALL
  348. SX6 ECSLTH
  349. SA6 ECFL
  350. CALL REQECS,ECFL
  351. CLOCK TIME
  352. DATE DATE
  353.  
  354. * WRITE ACCOUNT, COURSE, NAME OF PRINT REQUESTOR
  355. * TO ACCOUNT FILE
  356.  
  357. * CONTROL CARD TO ACCOUNT FILE
  358.  
  359. MESSAGE CCDR,5,RECALL
  360.  
  361. *
  362. * DAYFILE THE VERSION DATE AND TIME
  363. * MESSAGE TO JOB DAYFILE ONLY
  364. *
  365. MESSAGE VERZION,LOCAL,RECALL
  366. SA1 ACCOUNT
  367. BX6 X1
  368. SA6 ACCTNAM
  369. MESSAGE PRTING,1,RECALL
  370. EQ SETUP
  371. PRTING DATA 10H PRINTING
  372. ACCTNAM BSS 1
  373. DATA 0
  374. * /--- BLOCK SETUP 00 000 80/09/03 00.08
  375. * ************************************************
  376. TITLE SYSTEXT
  377. * ************************************************
  378. *
  379. ECSPRTY EQ *
  380. MESSAGE ECSMES,,RECALL
  381. CALL RELECS RELEASE ALL THE ECS
  382. ABORT
  383. EQ *
  384. *
  385. TITLE *MASTOR* REQUEST/COMMUNICATION ROUTINES
  386. *
  387. * MASTOR REQUEST ROUTINES
  388. *
  389. EXT REQECS,RELECS,OPF,CPF,READPF,GETARG
  390. *
  391. * ************************************************
  392. TITLE RETURN PROPER FILE TYPE
  393. **
  394. * + FILETYP +
  395. *
  396. * CALLABLE FROM FTN.
  397. *
  398. * THIS RETURNS THE PROPER, BLANK-FILLED PLATO
  399. * FILE TYPE, GIVEN THE NUMERIC VALUE FROM THE -FIW-
  400. *
  401. * WILLIAM M. GALCHER
  402. * JULY 10, 1978
  403. *
  404. *
  405. ENTRY FILETYP
  406.  
  407. FILETYP EQ *
  408. SA2 X1 GET OFFSET INTO TABLE
  409. PL X2,FTCHK -- BRIF .GT. 0
  410. BADFT SX2 0 SET TO *UNKNOWN*
  411. EQ FRET
  412. FTCHK SX3 X2-FTLTH SEE IF IN TABLE
  413. PL X3,BADFT
  414. FRET SA3 X2+FTINFO
  415. BX6 X3 AND STORE IT FOR -FTN-
  416. EQ FILETYP
  417. *
  418. FTINFO DATA 0HUNKNOWN TFINFO(0)
  419. DATA 0HTUTOR TUTOR, INSTRUCTOR, ROUTER
  420. DATA 0HBINARY BINARIES
  421. DATA 0HCURRICULUM NEW-STYLE CURRICULUM FILES
  422. DATA 0HDATAFILE STUDENT DATAFILES
  423. DATA 0HCODE COMPASS/BACKGROUND FILES
  424. DATA 0HGROUP NEW-STYLE GROUPS
  425. DATA 0HDATASET DATASETS
  426. DATA 0HPLMCURR PLM CURRICULUM FILE
  427. DATA 0HGNOTES GENERAL NOTES
  428. DATA 0HUNKNOWN FILE TYPE = J, BUT IS NOT DEFINED
  429. DATA 0HNAMESET NAMESETS
  430. DATA 0HACCOUNT ACCOUNT FILES
  431. DATA 0HCATALOG CATALOG FILES
  432. DATA 0HUNKNOWN FILE TYPE = N, BUT NOT DEFINED
  433. DATA 0HMODULE PLM MODULE FILE
  434. DATA 0HPNOTES NAMESET PNOTES FILE
  435. DATA 0HDOCUMENTOR NAMESET-TYPE DOCUMENTOR FILE
  436. FTLTH EQU *-FTINFO
  437. *
  438. TITLE -NOTYPES- ARGUMENT ERROR IN CONTROL CARD
  439. ENTRY NOTYPES
  440. NOTYPES EQ *
  441. MESSAGE MISTYPE,,RECALL
  442. CALL RELECS
  443. ABORT
  444. EQ *
  445. *
  446. * /--- BLOCK SHIFTS 00 000 78/07/03 03.40
  447. TITLE SHIFTS
  448. *
  449. * FUNCTIONS FOR LEFT AND RIGHT SHIFTS.
  450. * CALLABLE FROM FTN.
  451. *
  452. * LAWRENCE A. WHITE
  453. * AUGUST 11, 1976
  454. *
  455. ENTRY ISHL
  456. ISHL EQ *+400000B
  457. SA2 X1 VALUE TO BE SHIFTED
  458. SA1 A1+1
  459. SA3 X1 AMOUNT TO SHIFT IT
  460. SB2 X3
  461. LX6 X2,B2
  462. EQ ISHL
  463. *
  464. ENTRY ISHR
  465. ISHR EQ *+400000B
  466. SA2 X1
  467. SA1 A1+1
  468. SA3 X1
  469. SB2 X3
  470. AX6 X2,B2
  471. EQ ISHR
  472. *
  473. *
  474. * /--- BLOCK BLANK FILL 00 000 78/07/10 05.40
  475. TITLE ZERO TO BLANK ROUTINE
  476. *
  477. * -IBFILL-
  478. *
  479. * BLANK FILL ALL ARGUMENTS
  480. * CALLABLE FROM FTN. CALL IBFILL(I,J,K,L,M,N)
  481. * CONVERTS ALL 00B CHARS TO 55B
  482. *
  483. ENTRY IBFILL
  484. IBFILL EQ *
  485. SB1 1
  486. FILLLP ZR X1,IBFILL END OF ARGUMENTS CHECK
  487. SA5 X1 GET ARGUMENT
  488. RJ BLFILL BLANK FILL
  489. SA6 X1 RE-STORE BLANK FILLED VERSION
  490. SA1 A1+1 GET ADDRESS OF NEXT ARGUMENT
  491. EQ FILLLP GO FILL IT
  492.  
  493. *
  494. * ENTRY X5 = 10 CHARACTER WORD
  495. * EXIT X6 = SAME THING WITH 6/55B IN PLACE OF 6/0.
  496. *
  497.  
  498. BLFILL PS
  499. SA2 =40404040404040404040B
  500. BX3 -X5
  501. LX4 B1,X3
  502. BX3 X3*X4
  503. LX4 1
  504. BX3 X3*X4
  505. BX4 X3
  506. LX4 3
  507. BX3 X3*X4
  508. BX3 X3*X2
  509. BX4 X3
  510. LX4 -2
  511. BX3 X3+X4
  512. BX4 X3
  513. LX4 -3
  514. BX3 X3+X4
  515. BX6 X5+X3
  516. EQ BLFILL
  517. *
  518. * /--- BLOCK OPEN/CLOSE 00 000 81/01/28 12.31
  519. TITLE ATTACH PLATO FILE
  520. *
  521. * -ATTACH-
  522. * ATTACH SPECIFIED PLATO FILE
  523. *
  524. * ON ENTRY - X1 = ADDRESS OF FILE NAME
  525. *
  526. * ON EXIT - X1 = 0 IF ATTACH WORKED
  527. * = 1 IF AN ERROR OCCURRED
  528. * X2 = FIW INFO WORD
  529. *
  530. *
  531. ENTRY ATTACH
  532. ATTACH EQ *
  533. SA2 X1 GET FILE NAME
  534. BX6 X2
  535. SA6 PFILE
  536. CALL OPF,PFILE
  537. NZ X1,ATTERR ERROR CHECK
  538. BX6 X2
  539. SA6 FIW SAVE FILE INFO WD
  540. EQ ATTACH
  541. *
  542. PFILE DATA 0 PLATO FILE NAME
  543. DATA 0 EOL (FOR -MESSAGE-)
  544. *
  545. ATTERR BSS 0
  546. SX1 X1+5500B MAKE ERROR CODE ALPHA
  547. SA2 PFILE
  548. BX6 X1+X2
  549. SA6 A2 STORE WITH FILE NAME
  550. *
  551. MESSAGE ATTMES,,RECALL
  552. MESSAGE PFILE,,RECALL
  553. SA1 -1
  554. CALL RELECS RELEASE ALL ECS
  555. ABORT
  556. TITLE BOMBOFF IF NOT AN ACCOUNT
  557. **
  558. * + BADFILE +
  559. *
  560. * IF ONE TRIES TO ATTACH A FILE WHICH IS NOT
  561. * AN ACCOUNT FILE TO TRY TO READ THE NAMES OF
  562. * FILES, THE JOB IS A ABORTED WITH THE APPROPRIATE
  563. * MESSAGE DUMPED TO THE DAYFILE
  564. *
  565. **
  566. ENTRY BADFILE
  567. BADFILE EQ *
  568. MESSAGE NOACC,,RECALL
  569. MESSAGE PFILE,,RECALL
  570. CALL RELECS
  571. ABORT
  572.  
  573. *
  574. TITLE DETACH PLATO FILE
  575. *
  576. *
  577. * -DETACH-
  578. * DETACH SPECIFIED FILE
  579. *
  580. *
  581. ENTRY DETACH
  582. DETACH EQ *
  583. CALL CPF,PFILE
  584. EQ DETACH
  585. *
  586. *
  587. TITLE READ BLOCK FROM PLATO DISK FILE
  588. *
  589. *
  590. * -DISKIN-
  591. * READS SPECIFIED BLOCK FROM DISK AND TRANSFERS
  592. * IT TO THE CM BUFFER *BUFF*
  593. *
  594. * ON ENTRY - X1 = ADDRESS OF BLOCK NUMBER
  595. *
  596. *
  597. ENTRY DISKIN
  598. DISKIN EQ *
  599. CALL READPF,PFILE,X1,DISKBUF
  600. NZ X1,DISKERR ERROR CHECK
  601. *
  602. SX6 A0 SAVE A0 FOR FTN
  603. SA6 A0SAVE
  604.  
  605. SX0 DISKBUF ADDRESS OF ECS BUFFER
  606. SA0 BUFF
  607. + RE BLKLTH BRING BLOCK TO CM
  608. RJ ECSPRTY
  609. SA1 A0SAVE RESTORE A0
  610. SA0 X1
  611. EQ DISKIN
  612. *
  613. DISKERR MESSAGE DISKMES,,RECALL
  614. MX6 0
  615. SA6 BUFF SET END-OF-FILE
  616. SA6 BUFF+1
  617. EQ DISKIN EXIT
  618. *
  619. A0SAVE DATA 0 FOR SAVING A0 FOR FTN
  620. * /--- BLOCK STORAG/END 00 000 78/07/10 06.36
  621. TITLE STORAGE
  622. * ************************************************
  623. *
  624. SDATE MICRO 5,5,$"DATE"$
  625. SYEAR MICRO 2,2,$"DATE"$
  626. VERZION DIS 0,* VERSION "SDATE"/"SYEAR" "TIME"*
  627. ATTMES DIS ,*ERROR IN OPENING*
  628. NOACC DIS ,*NOT AN ACCOUNT*
  629. DISKMES DIS ,*DISK ERROR*
  630. ECSMES DIS ,*ECS ERROR*
  631. MISTYPE DIS ,*ARGUMENT ERROR - NO TYPES SPECIFIED*
  632. BADTYPE DIS ,*ARGUMENT ERROR - INVALID FILE TYPE*
  633. *
  634. IFNT BSS 1
  635. IECS VFD 60/DISKBUF
  636. *
  637. CMFL BSS 1
  638. ECFL BSS 1
  639. *
  640. SAV1 BSS 1
  641. SAV2 BSS 1
  642. ILOC BSS 1
  643. ILOC1 BSS 1
  644. *
  645. * ************************************************
  646. END
plato.source/plaopl/accprt.txt ยท Last modified: 2021/02/06 16:21 by 127.0.0.1