Retro1.org codex

User Tools

Site Tools

Trace: • APRT
plato:source:plaopl:aprt

Table of Contents

APRT

Table Of Contents

  • [00496] SUBROUTINES FOR LOG PRINTER
  • [00497] DEFFINITIONS
  • [00542] MACROS
  • [00561] -SETUP- LOAD TIME INITIALIZATIONS
  • [00601] SYSTEXT
  • [00623] -GETLINE- GET NEXT DATA RECORD
  • [00721] -ISTLIN- INITIALIZATIONS
  • [00751] -DATER- UNPACK HOLLERITH DATE
  • [00788] -DATEFIX- PUT YEAR FIRST, MONTH NEXT
  • [00823] ATTACH FILE
  • [00850] DETACH PLATO FILE
  • [00863] READ BLOCK FROM PLATO DISK FILE
  • [00897] SHIFTS
  • [00925] ZERO TO BLANK ROUTINE
  • [00989] STORAGE

Source Code

APRT.txt 
  1. APRT
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      ACCLOGPRT  00 000   79/05/03  12.28 
  4.       OVERLAY(APRINT,0,0) 
  5.       PROGRAM ACCPRT(INPUT,OUTPUT)
  6. C 
  7. C     COMMON DEFINITIONS
  8. C 
  9.       IMPLICIT INTEGER(A-Z) 
  10. C 
  11. C 
  12.       COMMON /ARGS/ FILE,ACCOUNT,STDATE,ENDATE,SHLNFL 
  13. C 
  14.       COMMON /DISK/ DISKADD,DISKF1,DISKF2,BUFF(320) 
  15. C 
  16.       COMMON /GETLINE/ BLOCK,NBLOCKS,TBLKS,NXT,END,LINE(64) 
  17. C 
  18.       COMMON /DATIME/ TIME,DATE 
  19. C 
  20. C 
  21. C 
  22. C     INITIALIZATIONS 
  23. C 
  24.       CALL SETUP
  25.       CALL ATTACH (FILE)
  26.       CALL DATEFIX(STDATE,STDATE) 
  27.       CALL DATEFIX(ENDATE,ENDATE) 
  28. 2     PRINT 1000
  29.       DO 10 I=1,11
  30.       BUFF(I)=10L********** 
  31. 10    CONTINUE
  32.       PRINT 1010,(BUFF(I),I=1,11) 
  33.       CALL IBFILL(FILE) 
  34.       PRINT 1020,FILE,DATE,TIME 
  35.       IF(ACCOUNT.EQ.0)GOTO 20 
  36.       I=ACCOUNT 
  37.       CALL IBFILL(I)
  38.       PRINT 1030,I
  39. 20    PRINT 1010,(BUFF(I),I=1,11) 
  40.       CALL DISKIN (0) 
  41. C  TOTAL BLOCKS IN FILE 
  42.       TBLKS=BUFF(3) 
  43. C  /////
  44. C  THE FOLLOWING CHECKS FOR OLD TYPE FILE DIRECTORY 
  45. C  ALL CODE BETWEEN THE *///* MARKERS CAN BE REMOVED
  46. C  ONCE ALL FILES ARE CONVERTED TO NEW FORMAT  LMK 1/20/76
  47. C 
  48.       IF(BUFF(4).LT.0)GOTO776 
  49. C 
  50.       I=BUFF(5)+1 
  51.       NBLOCKS=BUFF(I) 
  52.       GOTO  80
  53. C 
  54. 776   CONTINUE
  55. C//// 
  56. C  NUMBER OF BLOCKS IN USE
  57.       NBLOCKS = BUFF(4).AND.(77777B)
  58.  80   CALL ISTLIN 
  59.       IF(END.NE.0)GOTO 90 
  60. C 
  61. C     MAIN LOOP - PROCESS NEXT LOG ENTRY
  62. C 
  63. 100   CALL GETLINE
  64.       IF(END.NE.0)GOTO 90 
  65.       TYPE=LINE(1).AND.77B
  66.       IF(TYPE.NE.9)GOTO 100 
  67.       TYPE=LINE(2).AND.7777B
  68.       IF(TYPE.LE.0)GOTO 100 
  69. C 
  70. * /---   BLOCK      ACCLOGPRT  00 000   81/11/02  14.39 
  71. C     IF THE SHORTEN/LENGTHENS FLAG IS *SET2*, IGNORE ALL 
  72. C     TYPES EXCEPT'; CREATE=1, DESTROY=2, RENAME=3, COPY=4, 
  73. C     ARCHIVE=7, RETRIEVE=8, COPY CONTENTS=12, REPLACE=31,
  74. C     TRANSFER=49, OFFLINE COPY AND REPLACE = 54-59.
  75. C     IF *SET3*, IGNORE ALL EXCEPT'; ACCT RENAME TO=13, 
  76. C     ACCT RENAME FROM=14, ACCT CREATE=15, ACCT DESTROY=16, 
  77. C     CHANGE ACCT DIR=17, CHANGE SPACES=18, CHANGE SUBS=19, 
  78. C     CHANGE PUBLISH FLAG=21, CHANGE LESSON ACCESS=22,
  79. C     CHANGE ARCHIVE RIGHTS=25, CHANGE PRINT ACCESS=26, 
  80. C     CHANGE NETWORK OPTION=47, CHANGE TEST FLAG=53,
  81. C     CHANGE PARCEL LIMITS=60-62, CHANGE FREE SPACES=64,
  82. C     CHANGE CYBERNET TRANSMIT FLAG=65. 
  83. C     ERRORS (>65) ARE ALWAYS INCLUDED. 
  84. C 
  85.       IF(TYPE.GT.65) GOTO 130 
  86.       IF(SHLNFL.EQ.4LSET2) GOTO 110 
  87.       IF(SHLNFL.EQ.4LSET3) GOTO 120 
  88.       GOTO 130
  89. 110   GOTO (130,130,130,130,100,100,130,130,100,100,
  90.      *      100,130,100,100,100,100,100,100,100,100,
  91.      *      100,100,100,100,100,100,100,100,100,100,
  92.      *      130,100,100,100,100,100,100,100,100,100,
  93.      *      100,100,100,100,100,100,100,100,130,100,
  94.      *      100,100,100,130,130,130,130,130,130,100,
  95.      *      100,100,100,100,100) TYPE 
  96. 120   GOTO (100,100,100,100,100,100,100,100,100,100,
  97.      *      100,100,130,130,130,130,130,130,130,100,
  98.      *      130,130,100,100,130,130,100,100,100,100,
  99.      *      100,100,100,100,100,100,100,100,100,100,
  100.      *      100,100,100,100,100,100,130,100,100,100,
  101.      *      100,100,130,100,100,100,100,100,100,130,
  102.      *      130,130,100,130,130) TYPE 
  103. 130   CONTINUE
  104. * /---   BLOCK      ACCLOGPRT  00 000   81/12/10  11.03 
  105. C 
  106.       ACCN=LINE(2).AND.77777777777777000000B
  107.       IF(ACCOUNT.EQ.0)GOTO 150
  108.       IF(ACCOUNT.NE.ACCN)GOTO 100 
  109. 150   NAME=LINE(3)
  110.       COURSE=LINE(4).AND.77777777777777770000B
  111. C 
  112.       IF (STDATE.EQ.0)GOTO 160
  113.       CALL DATEFIX(LINE(5),I) 
  114.       IF (I.LT.STDATE) GOTO 100 
  115.       IF (ENDATE.EQ.0)GOTO 160
  116.       IF (I.GT.ENDATE) GOTO 100 
  117. C 
  118. 160   CALL DATER (LINE(5),IDATE)
  119.       ITIME=ISHL((LINE(5).AND.77777777B),36)
  120.       FILE1=LINE(6) 
  121.       PACK1=LINE(7) 
  122.       CALL IBFILL(FILE1,PACK1)
  123. C 
  124.       CALL IBFILL(ACCN,NAME,COURSE) 
  125.       REMOTE=LINE(2).AND.770000B
  126.       IF (REMOTE.EQ.0) GO TO 170
  127.       REMOTE=SHIFT((REMOTE.OR.(LINE(4).AND.7777B)),42)
  128.       PRINT 2000,IDATE,ITIME,ACCN,NAME,COURSE,REMOTE
  129.       GO TO 180 
  130. 170   STATN=LINE(4).AND.7777B 
  131.       SITE=STATN/32 
  132.       STATN=STATN.AND.37B 
  133.       PRINT 2010,IDATE,ITIME,ACCN,NAME,COURSE,SITE,STATN
  134. C 
  135. 180   IF(TYPE.GT.65) GOTO 900 
  136.       GOTO (210,220,230,240,250,260,270,280,290,300,
  137.      *      310,320,330,340,350,360,370,380,390,400,
  138.      *      410,420,430,440,450,460,470,480,490,500,
  139.      *      510,520,530,540,550,560,570,580,590,600,
  140.      *      610,620,630,640,650,660,670,680,690,700,
  141.      *      710,720,730,740,750,760,770,780,790,800,
  142.      *      810,820,830,840,850) TYPE 
  143. C 
  144. 210   PRINT 3010,FILE1,PACK1
  145.       GOTO 100
  146. C 
  147. 220   PRINT 3020,FILE1,PACK1
  148.       GOTO 100
  149. C 
  150. 230   FILE2=LINE(8) 
  151.       CALL IBFILL(FILE2)
  152.       PRINT 3030,FILE1,PACK1,FILE2
  153.       GOTO 100
  154. C 
  155. 240   FILE2=LINE(8) 
  156.       PACK2=LINE(9) 
  157.       CALL IBFILL(FILE2,PACK2)
  158.       PRINT 3040,FILE1,PACK1,FILE2,PACK2
  159.       GOTO 100
  160. C 
  161. 250   PACK2=LINE(8) 
  162.       CALL IBFILL(PACK2)
  163.       PRINT 3050,FILE1,PACK1,PACK2
  164.       GOTO 100
  165. C 
  166. 260   PACK2=LINE(8) 
  167.       CALL IBFILL(PACK2)
  168.       PRINT 3060,FILE1,PACK1,PACK2
  169.       GOTO 100
  170. C 
  171. 270   PRINT 3070,FILE1,PACK1
  172.       GOTO 100
  173. C 
  174. * /---   BLOCK      ACCLOGPRT  00 000   80/01/09  13.35 
  175. 280   FILE2=LINE(8) 
  176.       CALL IBFILL(FILE2)
  177.       PRINT 3080,FILE1,FILE2,PACK1
  178.       GOTO 100
  179. C 
  180. 290   PRINT 3090,FILE1
  181.       GOTO 100
  182. C 
  183. 300   PRINT 3100,FILE1
  184.       GOTO 100
  185. C 
  186. 310   PRINT 3110,FILE1
  187.       GOTO 100
  188. C 
  189. 320   FILE2=LINE(8) 
  190.       PACK2=LINE(9) 
  191.       CALL IBFILL(FILE2,PACK2)
  192.       PRINT 3120,FILE1,PACK1,FILE2,PACK2
  193.       GOTO 100
  194. C 
  195. 330   PRINT 3130,FILE1
  196.       GOTO 100
  197. C 
  198. 340   PRINT 3140,FILE1
  199.       GOTO 100
  200. C 
  201. 350   PRINT 3150
  202.       GOTO 100
  203. C 
  204. 360   PRINT 3160
  205.       GOTO 100
  206. C 
  207. 370   PRINT 3170
  208.       GOTO 100
  209. C 
  210. 380   PRINT 3180
  211.       GOTO 100
  212. C 
  213. 390   PRINT 3190
  214.       GOTO 100
  215. C 
  216. 400   PRINT 3200
  217.       GOTO 100
  218. C 
  219. 410   PRINT 3210
  220.       GOTO 100
  221. C 
  222. 420   PRINT 3220
  223.       GOTO 100
  224. C 
  225. 430   PRINT 3230
  226.       GOTO 100
  227. C 
  228. 440   PRINT 3240
  229.       GOTO 100
  230. C 
  231. 450   PRINT 3250
  232.       GOTO 100
  233. C 
  234. 460   PRINT 3260
  235.       GOTO 100
  236. C 
  237. 470   FILE2=LINE(7) 
  238.       CALL IBFILL(FILE2)
  239.       PRINT 3270,FILE1,FILE2
  240.       GOTO 100
  241. C 
  242. 480   PRINT 3280
  243.       GOTO 100
  244. C 
  245. 490   PRINT 3290
  246.       GOTO 100
  247. C 
  248. 500   PRINT 3300
  249.       GOTO 100
  250. C 
  251. 510   FILE2=LINE(8) 
  252.       PACK2=LINE(9) 
  253.       CALL IBFILL(FILE2,PACK2)
  254.       PRINT 3310,FILE2,PACK2,FILE1,PACK1
  255.       GOTO 100
  256. C 
  257. 520   PACK2=LINE(8) 
  258.       CALL IBFILL(PACK2)
  259.       PRINT 3320,FILE1,PACK1,PACK2
  260.       GOTO 100
  261. C 
  262. 530   PRINT 3330, FILE1 
  263.       GOTO 100
  264. C 
  265. 540   FILE2=LINE(8) 
  266.       PACK2=LINE(9) 
  267.       CALL IBFILL(FILE2,PACK2)
  268.       PRINT 3340,FILE1,PACK1,FILE2,PACK2
  269.       GOTO 100
  270. C 
  271. 550   PACK2=LINE(8) 
  272.       CALL IBFILL(PACK2)
  273.       PRINT 3350,FILE1,PACK1,PACK2
  274.       GOTO 100
  275. C 
  276. * /---   BLOCK      ACCLOGPRT  00 000   81/11/02  14.42 
  277. 560   PRINT 3360, FILE1 
  278.       GOTO 100
  279. C 
  280. 570   PRINT 3370, FILE1 
  281.       GOTO 100
  282. C 
  283. 580   PRINT 3380
  284.       GOTO 100
  285. C 
  286. 590   PRINT 3390
  287.       GOTO 100
  288. C 
  289. 600   PRINT 3400, FILE1 
  290.       GOTO 100
  291. C 
  292. 610   PRINT 3410, FILE1 
  293.       GOTO 100
  294. C 
  295. 620   PRINT 3420, FILE1 
  296.       GOTO 100
  297. C 
  298. 630   PRINT 3430
  299.       GOTO 100
  300. C 
  301. 640   PRINT 3440
  302.       GOTO 100
  303. C 
  304. 650   PRINT 3450
  305.       GOTO 100
  306. C 
  307. 660   FILE2=LINE(8) 
  308.       PACK2=LINE(9) 
  309.       CALL IBFILL(FILE2,PACK2)
  310.       PRINT 3460,FILE1,PACK1,FILE2,PACK2
  311.       GOTO 100
  312. C 
  313. 670   PRINT 3470
  314.       GOTO 100
  315. C 
  316. 680   FILE2=LINE(7) 
  317.       CALL IBFILL(FILE2)
  318.       PRINT 3480,FILE1,FILE2
  319.       GOTO 100
  320. C 
  321. 690   PRINT 3490,FILE1,PACK1
  322.       GOTO 100
  323. C 
  324. 700   PRINT 3500,FILE1,PACK1
  325.       GOTO 100
  326. C 
  327. 710   PRINT 3510,FILE1,PACK1
  328.       GOTO 100
  329. C 
  330. 720   PRINT 3520
  331.       GOTO 100
  332. C 
  333. 730   PRINT 3530
  334.       GOTO 100
  335. C 
  336. 740   PRINT 3540,FILE1,PACK1
  337.       GOTO 100
  338. C 
  339. 750   FILE2=LINE(8) 
  340.       PACK2=LINE(9) 
  341.       CALL IBFILL(FILE2,PACK2)
  342.       PRINT 3550,FILE2,PACK2,FILE1,PACK1
  343.       GOTO 100
  344. C 
  345. 760   PRINT 3560,FILE1,PACK1
  346.       GOTO 100
  347. C 
  348. 770   FILE2=LINE(8) 
  349.       PACK2=LINE(9) 
  350.       CALL IBFILL(FILE2,PACK2)
  351.       PRINT 3570,FILE2,PACK2,FILE1,PACK1
  352.       GOTO 100
  353. C 
  354. 780   PRINT 3580,FILE1,PACK1
  355.       GOTO 100
  356. C 
  357. 790   FILE2=LINE(8) 
  358.       PACK2=LINE(9) 
  359.       CALL IBFILL(FILE2,PACK2)
  360.       PRINT 3590,FILE2,PACK2,FILE1,PACK1
  361.       GOTO 100
  362. C 
  363. 800   PRINT 3600
  364.       GOTO 100
  365. C 
  366. 810   PRINT 3610
  367.       GOTO 100
  368. C 
  369. 820   PRINT 3620
  370.       GOTO 100
  371. C 
  372. 830   PRINT 3630,FILE1,PACK1
  373.       GOTO 100
  374. C 
  375. 840   PRINT 3640
  376.       GOTO 100
  377. C 
  378. 850   PRINT 3650
  379.       GOTO 100
  380. * /---   BLOCK      ACCLOGPRT  00 000   80/02/14  12.40 
  381. 900   PRINT 9000,TYPE 
  382.       GOTO 100
  383. C 
  384. 90    DO 95 I=1,11
  385.       BUFF(I)=10L********** 
  386. 95    CONTINUE
  387.       PRINT 1010,(BUFF(I),I=1,11) 
  388.       PRINT 1000
  389.       RETURN
  390. C 
  391. C 
  392. 1000  FORMAT (1H1)
  393. 1010  FORMAT (6X,11A10,//)
  394. 1020  FORMAT (6X,*ACCOUNT FILE MANAGEMENT LOG *,A10,4X, 
  395.      *        *PRINTED ON *,A9,2X,*AT *,A6,//)
  396. 1030  FORMAT (6X,*ACCOUNT *,A7,//)
  397. 2000  FORMAT (6X,A8,2X,A4,4X,*ACCOUNT *,A7,6X,*BY *,
  398.      *        A10,* / *,A8,* / *,A3)
  399. 2010  FORMAT (6X,A8,2X,A4,4X,*ACCOUNT *,A7,6X,*BY *,
  400.      *        A10,* / *,A8,*  AT*,I3,*-*,I2)
  401. 3010  FORMAT (24X,*CREATE FILE      *,A10,2X,A10,/) 
  402. 3020  FORMAT (24X,*DESTROY FILE     *,A10,2X,A10,/) 
  403. 3030  FORMAT (24X,*RE-NAME FILE     *,A10,2X,A10, 
  404.      *         5X,*NEW NAME  *,A10,/) 
  405. 3040  FORMAT (24X,*COPY FILE        *,A10,2X,A10, 
  406.      *         5X,*TO FILE   *,A10,2X,A10,/)
  407. 3050  FORMAT (24X,*LENGTHEN FILE    *,A10,2X,A10, 
  408.      *         5X,*NEW PACK  *,A10,/) 
  409. 3060  FORMAT (24X,*SHORTEN FILE     *,A10,2X,A10, 
  410.      *         5X,*NEW PACK  *,A10,/) 
  411. 3070  FORMAT (24X,*ARCHIVE FILE     *,A10,2X,A10,/) 
  412. 3080  FORMAT (24X,*RETRIEVE ARCHIVE *,A10,2X,*NEW NAME  *,
  413.      *        A10,5X,A10,/) 
  414. 3090  FORMAT (24X,*CHANGE CODEWORD  *,A10,/)
  415. 3100  FORMAT (24X,*ADD TO ACCOUNT   *,A10,/)
  416. 3110  FORMAT (24X,*REMOVE FROM ACCT *,A10,/)
  417. 3120  FORMAT (24X,*COPY CONTENTS    *,A10,2X,A10, 
  418.      *         5X,*TO FILE   *,A10,2X,A10,/)
  419. 3130  FORMAT (24X,*RENAME ACCT TO   *,A10,/)
  420. 3140  FORMAT (24X,*RENAME ACCT FROM *,A10,/)
  421. 3150  FORMAT (24X,*CREATE ACCOUNT*,/) 
  422. 3160  FORMAT (24X,*DESTROY ACCOUNT*,/)
  423. 3170  FORMAT (24X,*CHANGE ACCOUNT DIRECTOR*,/)
  424. 3180  FORMAT (24X,*CHANGE SPACES ALLOTTED*,/) 
  425. 3190  FORMAT (24X,*CHANGE SUBSCRIPTIONS*,/) 
  426. 3200  FORMAT (24X,*CHANGE AUTHOR SIGNON CREATION*,/)
  427. 3210  FORMAT (24X,*CHANGE PUBLICATION FLAG*,/)
  428. 3220  FORMAT (24X,*CHANGE LESSON ACCESS*,/) 
  429. 3230  FORMAT (24X,*CHANGE ACCOUNT CODEWORD*,/)
  430. 3240  FORMAT (24X,*CLEAR LESSON USAGE DATA*,/)
  431. 3250  FORMAT (24X,*CHANGE ARCHIVE RIGHTS*,/)
  432. 3260  FORMAT (24X,*CHANGE PRINT ACCESS*,/)
  433. 3270  FORMAT (24X,*CHANGE DEFAULT LESSON NOTES FILE FROM *, 
  434.      X        A10,*  TO  *,A10,/) 
  435. 3280  FORMAT (24X,*CHANGE DEFAULT FILE SECURITY CODE*,/)
  436. 3290  FORMAT (24X,*CHANGE SYSTEM ACCESS*,/) 
  437. 3300  FORMAT (24X,*CHANGE LIST OF MAJOR USERS*,/) 
  438. * /---   BLOCK      ACCLOGPRT  00 000   81/11/02  14.43 
  439. 3310  FORMAT (24X,*REPLACE FILE     *,A10,2X,A10, 
  440.      *         5X,*FROM FILE *,A10,2X,A10,/)
  441. 3320  FORMAT (24X,*PACK TRANSFER    *,A10,2X,A10, 
  442.      *         5X,*NEW PACK  *,A10,/) 
  443. 3330  FORMAT (24X,*CHANGE LESSON NOTES FILE*, 
  444.      *        20X,*OF FILE   *,A10,/) 
  445. 3340  FORMAT (24X,*COPY FILE        *,A10,2X,A10, 
  446.      *         5X,*TO FILE   *,A10, 
  447.      *         5X,*IN ACCOUNT *,A10,/)
  448. 3350  FORMAT (24X,*REORGANIZE FILE  *,A10,2X,A10, 
  449.      *         5X,*NEW PACK  *,A10,/) 
  450. 3360  FORMAT (24X,*CHANGE LESSON ACCESS CLASS*, 
  451.      *        18X,*OF FILE   *,A10,/) 
  452. 3370  FORMAT (24X,*CHANGE GROUP TYPE         *, 
  453.      *        18X,*OF FILE   *,A10,/) 
  454. 3380  FORMAT (24X,*EDIT WITH SYSTEM PRIVILEGES*,/)
  455. 3390  FORMAT (24X,*INSPECT WITH SYSTEM PRIVILEGES*,/) 
  456. 3400  FORMAT (24X,*CHANGE ACCESS LIST        *, 
  457.      *        18X,*OF FILE   *,A10,/) 
  458. 3410  FORMAT (24X,*CHANGE FILE OWNER         *, 
  459.      *        18X,*OF FILE   *,A10,/) 
  460. 3420  FORMAT (24X,*CHANGE FILE PRIVACY       *, 
  461.      *        18X,*FOR FILE  *,A10,/) 
  462. 3430  FORMAT (24X,*EDIT ACCOUNT ACCESS*,/)
  463. 3440  FORMAT (24X,*CHANGE ACCOUNT ACCESS LIST*,/) 
  464. 3450  FORMAT (24X,*DESTROY ACCOUNT ACCESS LIST*,/)
  465. 3460  FORMAT (24X,*RETRIEVE BACKUP  *,A10,2X,A10, 
  466.      *         5X,*TO FILE   *,A10,2X,A10,/)
  467. 3470  FORMAT (24X,*CHANGE INTER-SYSTEM LINK ACCESS*,/)
  468. 3480  FORMAT (24X,*CHANGE INTER-SYSTEM LINK LOGFILE FROM *, 
  469.      X        A10,*  TO  *,A10,/) 
  470. 3490  FORMAT (24X,*TRANSFER FILE    *,A10,2X,A10,/) 
  471. 3500  FORMAT (24X,*ARCHIVE TO OFFLIN*,A10,2X,A10,/) 
  472. 3510  FORMAT (24X,*ARCHIVE RETRIEVED*,A10,2X,A10,/) 
  473. 3520  FORMAT (24X,*CHANGE CURRENT USER COUNT*,/)
  474. 3530  FORMAT (24X,*CHANGE TEST ACCOUNT FLAG*,/) 
  475. 3540  FORMAT (24X,*COPY FILE OFFLINE*,A10,2X,A10,/) 
  476. 3550  FORMAT (24X,*REPLACE FILE OFFL*,A10,2X,A10, 
  477.      *         5X,*FROM FILE *,A10,2X,A10,/)
  478. 3560  FORMAT (24X,*COPY FILE FRM OFL*,A10,2X,A10,/) 
  479. 3570  FORMAT (24X,*REPL FILE FRM OFL*,A10,2X,A10, 
  480.      *         5X,*FROM FILE *,A10,2X,A10,/)
  481. 3580  FORMAT (24X,*COPY OFFLN->OFFLN*,A10,2X,A10,/) 
  482. 3590  FORMAT (24X,*REPL OFFLN->OFFLN*,A10,2X,A10, 
  483.      *         5X,*FROM FILE *,A10,2X,A10,/)
  484. 3600  FORMAT (24X,*CHANGE CURRENT NTU LIMIT*,/) 
  485. 3610  FORMAT (24X,*CHANGE DEFAULT NTU LIMIT*,/) 
  486. 3620  FORMAT (24X,*CHANGE CURRENT NTU COUNT*,/) 
  487. 3630  FORMAT (24X,*DELETE ARCHIVE FILE*,A10,2X,A10,/) 
  488. 3640  FORMAT (24X,*CHANGE NUMBER OF UNCHARGED DISK PARTS*,/)
  489. 3650  FORMAT (24X,*CHANGE CYBERNET TRANSMIT FLAG*,/)
  490. 9000  FORMAT (24X,*INVALID LOG RECORD, TYPE*,I3,/)
  491. C 
  492. C 
  493.       END 
  494. * /---   BLOCK      DEFINES    00 000   77/04/26  21.28 
  495.           IDENT  LOGSUB 
  496.           TITLE  SUBROUTINES FOR LOG PRINTER
  497.           TITLE  DEFFINITIONS 
  498. *         ************************************************
  499. * 
  500. * 
  501.  BLKLTH   EQU    320
  502. * 
  503. * 
  504.  DISKBUF  EQU    0
  505.  ECSLTH   EQU    DISKBUF+BLKLTH 
  506. * 
  507. * 
  508.           USE    /ARGS/ 
  509.  FILE     BSS    1           DATA FILE NAME 
  510.  ACCOUNT  BSS    1           ACCOUNT NAME 
  511.  STDATE   BSS    1           STARTING DATE
  512.  ENDATE   BSS    1           ENDING DATE
  513.  SHLNFL   BSS    1           SHORTEN/LENGTHEN FLAG
  514. * 
  515. * 
  516.           USE    /DISK/ 
  517.  DISKADD  BSS    1           DISK ADDRESS OF FILE 
  518.  DISKF1   BSS    1
  519.  DISKF2   VFD    48/BLKLTH,12/1 
  520.  BUFF     BSS    BLKLTH 
  521. * 
  522. * 
  523.           USE    /GETLINE/
  524.  BLOCK    BSS    1           CURRENT BLOCK NUMBER 
  525.  NBLOCKS  BSS    1           NUMBER OF BLOCKS IN FILE 
  526.  TBLKS    BSS    1           TOTAL NUMBER OF BLOCKS IN FILE 
  527.  NXT      BSS    1           POINTER TO NEXT WORD 
  528.  END      BSS    1
  529.  LINE     BSS    64 
  530. * 
  531. * 
  532.           USE    /DATIME/ 
  533.  TIME     BSS    1
  534.  DATE     BSS    1
  535. * 
  536. * 
  537.           USE 
  538. * 
  539. * 
  540. *         ************************************************
  541. * /---   BLOCK      MACROS     00 000   76/11/05  11.52 
  542.           TITLE  MACROS 
  543. *         ************************************************
  544. * 
  545. * 
  546. * 
  547.           PURGMAC CALL
  548.  CALL     MACRO  NAME,ARG1,ARG2,ARG3
  549.           IFC    NE,**ARG3*,1 
  550.           SB3    ARG3 
  551.           IFC    NE,**ARG2*,1 
  552.           SB2    ARG2 
  553.           IFC    NE,**ARG1*,1 
  554.           SB1    ARG1 
  555.           RJ     =X_NAME_ 
  556.           ENDM
  557. * 
  558. * 
  559. *         ******************
  560. * /---   BLOCK      SETUP      00 000   76/11/05  21.39 
  561.           TITLE  -SETUP-     LOAD TIME INITIALIZATIONS
  562. *         ************************************************
  563. * 
  564. * 
  565. * 
  566. *         -SETUP- 
  567. *         LOAD TIME INITIALIZATIONS - SET CM AND ECS FL 
  568. * 
  569. * 
  570.           SST 
  571.           SYSCOM
  572. * 
  573.           ENTRY  SETUP
  574.  SETUP    EQ     *
  575.           CALL   GETARG      NAME OF FILE TO PRINT
  576.           SA6    FILE 
  577.           CALL   GETARG      NAME OF ACCOUNT TO PRINT 
  578.           SA6    ACCOUNT
  579.           CALL   GETARG      DATE TO START PRINTING 
  580.           SA6    STDATE 
  581.           CALL   GETARG      DATE TO END PRINTING 
  582.           SA6    ENDATE 
  583.           CALL   GETARG      SHORTEN/LENGHTEN PRINT FLAG
  584.           SA6    SHLNFL 
  585.           SA1    LWPR        LAST WORD OF PROGRAM 
  586.           SX6    X1+100B     ROUND UP BY 100B 
  587.           MX0    -6 
  588.           BX6    X0*X6
  589.           LX6    30 
  590.           SA6    CMFL        SET CM FIELD LENGTH
  591.           MEMORY CM,CMFL,RECALL 
  592.           SX6    ECSLTH 
  593.           SA6    ECFL 
  594.           CALL   REQECS,ECFL
  595.           CLOCK  TIME 
  596.           DATE   DATE 
  597.           EQ     SETUP
  598. * 
  599. * 
  600. *         ************************************************
  601.           TITLE  SYSTEXT
  602. *         ************************************************
  603. * 
  604. * 
  605. * 
  606.  ECSPRTY  EQ     *
  607.           MESSAGE ECSMES,,RECALL
  608.           CALL   RELECS      RELEASE ALL THE ECS
  609.           ABORT 
  610.           EQ     *
  611. * 
  612. * 
  613. * 
  614. *CALL     COMCSYS 
  615. * 
  616. * 
  617. *         MASTOR REQUEST ROUTINES 
  618. * 
  619.           EXT    REQECS,RELECS,OPF,CPF,READPF,GETARG
  620. * 
  621. *         ************************************************
  622. * /---   BLOCK      GETLINE    00 000   75/10/11  19.46 
  623.           TITLE  -GETLINE-   GET NEXT DATA RECORD 
  624. *         ************************************************
  625. * 
  626. * 
  627. * 
  628. *         -GETLINE- 
  629. *         READS NEXT DATA RECORD TO *LINE*
  630. * 
  631. * 
  632.           ENTRY  GETLINE
  633.  GETLINE  EQ     *
  634.           SA1    NXT
  635.           SB1    X1          B1 = POINTER TO NEXT WORD
  636.           RJ     ISTWORD
  637.           BX6    X1          STORE HEADER WORD
  638.           SA6    LINE 
  639.           MX0    -6          MASK FOR RECORD LENGTH 
  640.           AX1    6
  641.           BX1    -X0*X1      MASK OFF RECORD LENGTH 
  642.           ZR     X1,ENDFIL
  643.           SB2    1           INDEX IN *LINE*
  644.           SB3    X1          END TEST 
  645. * 
  646.  GETLP    GE     B2,B3,ENDLIN 
  647.           RJ     NXTWORD     GET NEXT WORD OF DATA
  648.           BX6    X1 
  649.           SA6    B2+LINE     MOVE TO *LINE* BUFFER
  650.           SB2    B2+1 
  651.           SB4    B2-64
  652.           NG     B4,GETLP 
  653.           EQ     ENDFIL 
  654. * 
  655.  ENDLIN   SX6    B1 
  656.           SA6    NXT         UPDATE WORD POINTER
  657.           EQ     GETLINE
  658. * 
  659. * 
  660. * 
  661. *         -NXTWORD- 
  662. *         GET NEXT WORD OF DATA RECORD
  663. * 
  664. * 
  665.  NXTWORD  EQ     *
  666.           SX1    B1-BLKLTH   SEE IF AT END OF BUFFER
  667.           PL     X1,NXTW1 
  668.           SA1    B1+BUFF     LOAD NEXT WORD 
  669.           SB1    B1+1        ADVANCE POINTER
  670.           EQ     NXTWORD
  671. * 
  672.  NXTW1    RJ     NXTBLOK     GET NEXT BLOCK 
  673.           EQ     NXTWORD
  674. * 
  675. * 
  676. * /---   BLOCK      GETLINE    00 000   77/04/26  21.30 
  677. * 
  678. *         -ISTWORD- 
  679. *         GET FIRST WORD OF DATA RECORD 
  680. * 
  681.  ISTWORD  EQ     *
  682.           RJ     NXTWORD     GET NEXT WORD
  683.           NZ     X1,ISTWORD 
  684.           RJ     NXTBLOK     GET NEXT BLOCK 
  685.           EQ     ISTWORD
  686. * 
  687. * 
  688.  NXTBLOK  EQ     *
  689.           SX6    B2          SAVE REGISTERS 
  690.           SA6    SAV1 
  691.           SX6    B3 
  692.           SA6    SAV2 
  693.           SA1    BLOCK       BLOCK CURRENTLY ON 
  694.           SX7    X1+1 
  695.           SA7    A1          UPDATE BLOCK COUNT 
  696.           SA2    NBLOCKS     NUMBER OF BLOCKS IN FILE 
  697.           IX2    X1-X2
  698.           PL     X2,ENDFIL   JUMP IF END-OF-FILE
  699.           SA2    TBLKS       TOTAL NUM OF BLOCKS IN FILE
  700.           IX2    X7-X2
  701.           PL     X2,ENDFIL   IF END-OF-FILE 
  702.           SX1    BLOCK       BLOCK TO READ
  703.           CALL   DISKIN 
  704.           SB1    1           RESET WORD POINTER 
  705.           SA1    SAV1 
  706.           SB2    X1          RESTORE B2 
  707.           SA1    SAV2 
  708.           SB3    X1          RESTORE B3 
  709.           SA1    BUFF        LOAD NEXT WORD 
  710.           EQ     NXTBLOK
  711. * 
  712.  ENDFIL   MX6    -1          SET END-OF-FILE FLAG 
  713.           SA6    END
  714.           MX6    0
  715.           SA6    LINE        CLEAR HEADER WORD
  716.           EQ     GETLINE
  717. * 
  718. * 
  719. *         ************************************************
  720. * /---   BLOCK      GETLINE    00 000   76/11/05  12.09 
  721.           TITLE  -ISTLIN-    INITIALIZATIONS
  722. *         ************************************************
  723. * 
  724. * 
  725. * 
  726. *         -ISTLIN-
  727. *         INITIALIZATIONS BEFORE FIRST -GETLINE- CALL 
  728. * 
  729. * 
  730.           ENTRY  ISTLIN 
  731.  ISTLIN   EQ     *
  732.           SX6    1           INITIALIZE BLOCK COUNTER 
  733.           SA6    BLOCK
  734.           SA1    NBLOCKS
  735.           NG     X1,ISTEND
  736.           ZR     X1,ISTEND
  737.           MX6    0
  738.           SA6    END         INITIALIZE END-OF-FILE FLAG
  739.           SA6    NXT         INITIALIZE WORD POINTER
  740.           SX1    =1          READ BLOCK 1 
  741.           CALL   DISKIN 
  742.           EQ     ISTLIN 
  743. * 
  744.  ISTEND   MX6    -1          MARK END-OF-FILE 
  745.           SA6    END
  746.           EQ     ISTLIN 
  747. * 
  748. * 
  749. *         ************************************************
  750. * /---   BLOCK      DATER      00 000   76/11/05  12.21 
  751.           TITLE  -DATER-     UNPACK HOLLERITH DATE
  752. *         ************************************************
  753. * 
  754. * 
  755. * 
  756. *         -DATER- 
  757. *         UNPACKS AND RE-FORMATS DATE FOR PRINTING
  758. *         (FTN CALLABLE)
  759. * 
  760. * 
  761.           ENTRY  DATER
  762.  DATER    EQ     *
  763.           MX0    -12
  764.           SX2    1R/
  765.           SA4    X1          LOAD COMPRESSED DATE 
  766.           LX4    12 
  767.           BX6    -X0*X4      MASK OFF FIRST TWO CHARACTERS
  768.           LX6    6
  769.           BX6    X2+X6       ATTACH A SLASH 
  770.           LX6    12 
  771.           LX4    12 
  772.           BX3    -X0*X4 
  773.           BX6    X3+X6       ATTACH NEXT TWO CHARACTERS 
  774.           LX6    6
  775.           BX6    X2+X6       ATTACH A SLASH 
  776.           LX6    12 
  777.           LX4    12 
  778.           BX3    -X0*X4 
  779.           BX6    X3+X6       ATTACH LAST TWO CHARACTERS 
  780.           LX6    12 
  781.           SA1    A1+1        GET ADDR OF 2ND ARG
  782.           SA6    X1          SAVE 
  783.           EQ     DATER
  784. * 
  785. * 
  786. *         ************************************************
  787. * /---   BLOCK      DATEFIX    00 000   76/11/05  12.24 
  788.           TITLE  -DATEFIX-  PUT YEAR FIRST, MONTH NEXT
  789. *         ************************************************
  790. * 
  791. * 
  792. * 
  793. *         -DATEFIX- 
  794. *         PUTS YEAR IN MOST SIGNIFICANT PLACE, MONTH NEXT.
  795. * ENTERS IN FORMAT';  MM DD YY  (LEFT JUSTIFIED)
  796. * RETURNS IN FORMAT'; YY MM DD  (RIGHT JUSTIFIED) 
  797. * 
  798. * 
  799.           ENTRY  DATEFIX
  800.  DATEFIX  EQ     *
  801.           MX0    -12
  802.           SA4    X1          GET DATE 
  803.           LX4    12          GET MONTH
  804.           BX6    -X0*X4 
  805.           LX6    12 
  806. * 
  807.           LX4    12          GET DAY NEXT 
  808.           BX2    -X0*X4 
  809.           BX6    X6+X2
  810. * 
  811.           LX4    12          NOW FOR YEAR 
  812.           BX2    -X0*X4 
  813.           LX2    24 
  814.           BX6    X6+X2
  815. * 
  816.           SA1    A1+1        ADDR OF 2ND ARG
  817.           SA6    X1 
  818.           EQ     DATEFIX
  819. * 
  820. * 
  821. *         ************************************************
  822. * /---   BLOCK      DISKIN     00 000   76/11/05  12.12 
  823.           TITLE  ATTACH FILE
  824. * 
  825. * 
  826. *         -ATTACH-
  827. *         ATTACH SPECIFIED FILE 
  828. * 
  829. *         ON ENTRY - X1 = ADDRESS OF FILE NAME
  830. * 
  831. * 
  832.           ENTRY  ATTACH 
  833.  ATTACH   EQ     *
  834.           SA2    X1          GET FILE NAME
  835.           BX6    X2 
  836.           SA6    PFILE
  837.           CALL   OPF,PFILE
  838.           NZ     X1,ATTERR   ERROR CHECK
  839.           EQ     ATTACH 
  840. * 
  841.  PFILE    DATA   0           PLATO FILE NAME
  842.           DATA   0           EOL
  843. * 
  844.  ATTERR   MESSAGE ATTMES,,RECALL
  845.           MESSAGE PFILE,,RECALL 
  846.           CALL   RELECS      RELEASE ALL ECS
  847.           ABORT 
  848.  
  849. * 
  850.           TITLE  DETACH PLATO FILE
  851. * 
  852. * 
  853. *         -DETACH-
  854. *         DETACH SPECIFIED FILE 
  855. * 
  856. * 
  857.           ENTRY  DETACH 
  858.  DETACH   EQ     *
  859.           CALL   CPF,PFILE
  860.           EQ     DETACH 
  861. * 
  862. * 
  863.           TITLE  READ BLOCK FROM PLATO DISK FILE
  864. * 
  865. * 
  866. *         -DISKIN-
  867. *         READS SPECIFIED BLOCK FROM DISK AND TRANSFERS 
  868. *         IT TO THE CM BUFFER *BUFF*
  869. * 
  870. *         ON ENTRY -  X1 = ADDRESS OF BLOCK NUMBER
  871. * 
  872. * 
  873.           ENTRY  DISKIN 
  874.  DISKIN   EQ     *
  875.           CALL   READPF,PFILE,X1,DISKBUF
  876.           NZ     X1,DISKERR  ERROR CHECK
  877. * 
  878.           SX6    A0          SAVE A0 FOR FTN
  879.           SA6    A0SAVE 
  880.  
  881.           SX0    DISKBUF     ADDRESS OF ECS BUFFER
  882.           SA0    BUFF 
  883. +         RE     BLKLTH      BRING BLOCK TO CM
  884.           RJ     ECSPRTY
  885.           SA1    A0SAVE      RESTORE A0 
  886.           SA0    X1 
  887.           EQ     DISKIN 
  888. * 
  889.  DISKERR  MESSAGE DISKMES,,RECALL 
  890.           MX6    0
  891.           SA6    BUFF        SET END-OF-FILE
  892.           SA6    BUFF+1 
  893.           EQ     DISKIN      EXIT 
  894. * 
  895.  A0SAVE   DATA   0           FOR SAVING A0 FOR FTN
  896. * /---   BLOCK      SHIFTS     00 000   76/11/05  12.50 
  897.           TITLE  SHIFTS 
  898. * 
  899. *         FUNCTIONS FOR LEFT AND RIGHT SHIFTS.
  900. *         CALLABLE FROM FTN.
  901. * 
  902. *         LAWRENCE A. WHITE 
  903. *         AUGUST 11, 1976 
  904. * 
  905.           ENTRY  ISHL 
  906.  ISHL     EQ     *+400000B
  907.           SA2    X1          VALUE TO BE SHIFTED
  908.           SA1    A1+1 
  909.           SA3    X1          AMOUNT TO SHIFT IT 
  910.           SB2    X3 
  911.           LX6    X2,B2
  912.           EQ     ISHL 
  913. * 
  914.           ENTRY  ISHR 
  915.  ISHR     EQ     *+400000B
  916.           SA2    X1 
  917.           SA1    A1+1 
  918.           SA3    X1 
  919.           SB2    X3 
  920.           AX6    X2,B2
  921.           EQ     ISHR 
  922. * 
  923. * 
  924. * /---   BLOCK      BLANKFILL  00 000   76/11/05  12.51 
  925.           TITLE  ZERO TO BLANK ROUTINE
  926. * 
  927. *         -IBFILL-
  928. * 
  929. *         BLANK FILL ALL ARGUMENTS
  930. *         CALLABLE FROM FTN.    CALL IBFILL(I,J,K,L,M,N)
  931. *         CONVERTS ALL 00B CHARS TO 55B 
  932. * 
  933.           ENTRY  IBFILL 
  934.  IBFILL   EQ     *
  935.           SB1    1
  936.  FILLLP   ZR     X1,IBFILL   END OF ARGUMENTS CHECK 
  937.           SA5    X1          GET ARGUMENT 
  938.           RJ     BLFILL      BLANK FILL 
  939.           SA6    X1          RE-STORE BLANK FILLED VERSION
  940.           SA1    A1+1        GET ADDRESS OF NEXT ARGUMENT 
  941.           EQ     FILLLP      GO FILL IT 
  942.  
  943. * 
  944. *         -IBFILLB- 
  945. * 
  946. *         BLANK FILL A BUFFER (CALLABLE FROM FTN) 
  947. * 
  948. *         CALL IBFILLB(BUFFER,NWORDS) 
  949. *         BLANK FILLS *BUFFER* THROUGH *BUFFER+NWORDS-1*
  950. * 
  951.           ENTRY  IBFILLB
  952.  IBFILLB  EQ     *
  953.           SB1    1
  954.           SA5    X1          GET FIRST WORD OF BUFFER 
  955.           SA1    A1+1        GET ADDRESS OF NUMBER WORDS
  956.           SA1    X1          GET NUMBER WORDS 
  957.  FILLBLP  RJ     BLFILL      BLANK FILL WORD
  958.           SA6    A5          RE-STORE 
  959.           SX1    X1-1        DECREMENT WORD COUNTER 
  960.           ZR     X1,IBFILLB  ALL FILLED, ---RETURN
  961.           SA5    A5+1        GET NEXT WORD
  962.           EQ     FILLBLP
  963.  
  964. * 
  965. *         ENTRY  X5 = 10 CHARACTER WORD 
  966. *         EXIT   X6 = SAME THING WITH 6/55B IN PLACE OF 6/0.
  967. * 
  968.  BLFILL   PS
  969.           SA2    =40404040404040404040B 
  970.           BX3    -X5
  971.           LX4    B1,X3
  972.           BX3    X3*X4
  973.           LX4    1
  974.           BX3    X3*X4
  975.           BX4    X3 
  976.           LX4    3
  977.           BX3    X3*X4
  978.           BX3    X3*X2
  979.           BX4    X3 
  980.           LX4    -2 
  981.           BX3    X3+X4
  982.           BX4    X3 
  983.           LX4    -3 
  984.           BX3    X3+X4
  985.           BX6    X5+X3
  986.           EQ     BLFILL 
  987. * 
  988. * /---   BLOCK      END        00 000   75/10/11  19.55 
  989.           TITLE  STORAGE
  990. *         ************************************************
  991. * 
  992. * 
  993. * 
  994.  ATTMES   DIS    ,*ATTACH ERROR*
  995.  DISKMES  DIS    ,*DISK ERROR*
  996.  ECSMES   DIS    ,*ECS ERROR* 
  997. * 
  998.  IFNT     BSS    1
  999.  IECS     VFD    60/DISKBUF 
  1000. * 
  1001.  CMFL     BSS    1
  1002.  ECFL     BSS    1
  1003. * 
  1004.  SAV1     BSS    1
  1005.  SAV2     BSS    1
  1006.  ILOC     BSS    1
  1007.  ILOC1    BSS    1
  1008. * 
  1009. * 
  1010. *         ************************************************
  1011.           END
plato/source/plaopl/aprt.txt · Last modified: 2023/08/05 18:54 by Site Administrator