OVERLAY (BLKDBLK,0,0) 00000001 PROGRAMMED BY JW 00000002 DATA MINSIZE / 11000B / 00000003 IF (IGETFL(0) .LE. MIN SIZE) GO TO 10 00000004 CALL OVERLAY (7HBLOCKER,0,0,0) 00000005 STOP 00000006 10 CALL TIME (36HFIELD LENGTH TOO SMALL, NEED 11000B.) 00000007 END 00000008 ASCENT GETFL 00000009 ENTRY IGETFL 00000010 IGETFL JP * 00000011 SX6 A0 00000012 ZR IGETFL 00000013 END 00000014 OVERLAY (BLOCKER,0,0) 00000015 P R O G R A M M E 00000016 00000017 COMMON / / LOCW, WSIZE, W(1) 00000018 INTEGER LOCW, W, WSIZE 00000019 00000020 COMMON /FILECTL/ FILE, INPUT(8), OUTPUT(8), INFILE(8), 00000021 . OUTFILE(8), ZERO 00000022 INTEGER FILE, INFILE, INPUT, OUTFILE, OUTPUT, ZERO 00000023 DATA INPUT(1), OUTPUT(1), INFILE(1), OUTFILE(1), ZERO 00000024 . /5LINPUT , 6LOUTPUT , 2LIN , 3LOUT , 0 / 00000025 00000026 INTEGER BUF SIZE, LINE(40), STATUS 00000027 00000028 WSIZE = IGETFL(0) - LOCF(W) 00000029 LOCW = LOCF(W) 00000030 INPUT(1) = INPUT(1) .OR. 3 00000031 INPUT(2) = INPUT(3) = INPUT(4) = LOCW 00000032 INPUT(5) = INPUT(2) + 129 00000033 INPUT(6) = 0 00000034 INPUT(7) = 2 00000035 00000036 OUTPUT(1) = OUTPUT(1) .OR. 3 00000037 OUTPUT (2) = OUTPUT(3) = OUTPUT(4) = INPUT(5) 00000038 OUTPUT(5) = OUTPUT(2) + 129 00000039 OUTPUT(6) = 0 00000040 OUTPUT(7) = 2 00000041 00000042 BUF SIZE = (WSIZE - (OUTPUT(5) - LOCW))/2 00000043 INFILE(1) = INFILE(1) .OR. 1 00000044 INFILE(2) = INFILE(3) = INFILE(4) = OUTPUT(5) 00000045 INFILE(5) = INFILE(2) + BUF SIZE 00000046 INFILE(6) = INFILE(7) = 0 00000047 00000048 OUTFILE(1) = OUTFILE(1) .OR. 1 00000049 OUTFILE(2) = OUTFILE(3) = OUTFILE(4) = INFILE(5) 00000050 OUTFILE(5) = OUTFILE(2) + BUFSIZE 00000051 OUTFILE(6) = OUTFILE(7) = 0 00000052 00000053 FILE = 2 00000054 1 STATUS = -1 00000055 CALL PUT LINE (69H1 BLOCK/DEBLOCK PROGRAM WRITT00000056 .EN BY J. A. WHITE, III,0) 00000057 CALL PUT LINE(30H0 FLORIDA STATE UNIVERSITY,0) 00000058 CALL PUT LINE (1H0,0) 00000059 FILE = 1 00000060 CALL GET REC (LINE, 80, STATUS) 00000061 IF (STATUS .EQ. 20B .OR. STATUS .EQ. 30B) STOP 00000062 FILE = 2 00000063 CALL PUT LINE (LINE, 0) 00000064 CALL PUT LINE (0, 20B) 00000065 IF (LINE(1) .NE. 10H ) CALL TRIM(LINE(1),1) 00000066 IF (LINE(1) .NE. 10H ) INFILE(1) = LINE(1) .OR. 1 00000067 00000068 IF (LINE(2) .NE. 1H ) INFILE(7) = 2 00000069 IF (LINE(3) .NE. 10H ) CALL TRIM(LINE(3),1) 00000070 IF (LINE(3) .NE. 10H ) OUTFILE(1) = LINE(3) .OR. 1 00000071 IF (LINE(4) .NE. 1H ) OUTFILE(7) = 2 00000072 INFILE(1) = INFILE(1) .OR. INFILE(7) 00000073 OUTFILE (1) = OUTFILE(1) .OR. OUTFILE(7) 00000074 CALL WAIT 00000075 L = LINE(5) 00000076 FILE = 1 00000077 10 CALL GET LINE(LINE,STATUS) 00000078 IF (STATUS .NE. 20B) GO TO 10 00000079 CALL TRIM(L,1) 00000080 IF (L .EQ. 5LBLOCK) GO TO 100 00000081 IF (L .EQ. 7LDEBLOCK) GO TO 200 00000082 100 FILE = 3 00000083 STATUS = -1 00000084 CALL GET LINE (LINE, STATUS) 00000085 FILE = 4 00000086 CALL PUT E LIN (LINE, STATUS) 00000087 IF (STATUS .NE. 30B) GO TO 100 00000088 GO TO 999 00000089 00000090 200 FILE = 3 00000091 STATUS = -1 00000092 CALL GET E LIN (LINE, STATUS) 00000093 FILE = 4 00000094 CALL PUT LINE (LINE,STATUS) 00000095 IF (STATUS .NE. 30B) GO TO 200 00000096 GO TO 999 00000097 00000098 999 CALL WAIT 00000099 STOP 00000100 END 00000101 SUBROUTINE TRIM (LINE, N) 00000102 00000103 INTEGER LINE(N) 00000104 00000105 INTEGER I, J, WORD 00000106 00000107 00000108 I = N 00000109 10 WORD = LINE(I) 00000110 DO 20 J=1, 10 00000111 IF ((WORD .AND. 77B) .NE. 1R ) GO TO 30 00000112 WORD = ISHIFT(WORD .AND. 7777 7777 7777 7777 7700B, 54) 00000113 20 CONTINUE 00000114 LINE(I) = WORD 00000115 I = I - 1 00000116 IF (I .GT. 0) GO TO 10 00000117 RETURN 00000118 00000119 30 LINE(I) = ISHIFT (WORD,6*J-6) 00000120 RETURN 00000121 END 00000122 SUBROUTINE GET CORR (LINE, STATUS) 00000123 00000124 INTEGER LINE(1), STATUS 00000125 00000126 COMMON /FILECTL/ FILE 00000127 INTEGER FILE 00000128 00000129 COMMON /EDITCTL/ MASTER, UPDATED, CORRECT, LISTING, EDITEXT, 00000130 . COR REC L 00000131 INTEGER COR REC L, CORRECT, EDITEXT, LISTING, MASTER, UPDATED 00000132 00000133 INTEGER EOF 00000134 DATA EOF / 30B / 00000135 00000136 C 00000137 C THIS SUBROUTINE PERFORMS THE READING OF THE CORRECTION FILE,00000138 C RETURNING WITH A VALID LINE (WITH -STATUS- SET TO 0) OR WITH 00000139 C A NON-ZERO -STATUS- INDICATING SOME FORM OF END-OF-INFORMATION 00000140 C (I.E. EITHER AN -EOR- OR AN -EOF- UNDER SCOPE 2.0). 00000141 C 00000142 00000143 STATUS = EOF 00000144 IF (CORRECT .LE. 0) RETURN 00000145 FILE = CORRECT 00000146 CALL GET REC (LINE, STATUS, COR REC L) 00000147 STATUS = 0 00000148 RETURN 00000149 00000150 END 00000151 SUBROUTINE COPY SRC (SFILE, RLENGTH, SEQ, INC) 00000152 00000153 INTEGER INC, RLENGTH, SEQ, SFILE 00000154 00000155 COMMON /FILECTL/ FILE, F(8,1) 00000156 INTEGER F, FILE 00000157 00000158 INTEGER FMT(1), ICH, IWD, JCH, LINE(20), SEQ1, STATUS 00000159 00000160 SEQ1 = SEQ 00000161 IWD = (RLENGTH + 9)/10 00000162 ICH = RLENGTH - IWD*10 00000163 IF (ICH .EQ. 0) ICH = 10 00000164 JCH = ICH + 12 00000165 ENCODE (9,1000,FMT) ICH 00000166 1000 FORMAT (*(A*,I2,*,I12)*) 00000167 KWD = (RLENGTH + 12 + 9)/10 00000168 KCH = 6*(RLENGTH + 2 - 10*KWD) 00000169 LINE(KWD+1) = 0 00000170 MASK = ISHIFT(4000 0000 0000 0000 0000B,-KCH) 00000171 00000172 10 FILE = SFILE 00000173 CALL GET REC (LINE, RLENGTH, STATUS) 00000174 IF (STATUS .NE. 0) GO TO 20 00000175 ENCODE (JCH,FMT,LINE(IWD)) LINE(IWD), SEQ1 00000176 SEQ1 = SEQ1 + INC 00000177 LINE(KWD) = LINE(KWD) .AND. MASK 00000178 CALL UPDATE (LINE, 0) 00000179 CALL LISTING (LINE, 0) 00000180 CALL EDITEXT (LINE, 0) 00000181 GO TO 10 00000182 20 CALL UPDATE (0, 20B) 00000183 F(1,SFILE) = F(1,SFILE) .AND. .NOT. STATUS 00000184 RETURN 00000185 END 00000186 SUBROUTINE GET REC (LINE, RLENGTH, STATUS) 00000187 00000188 INTEGER LINE(1), RLENGTH, STATUS 00000189 INTEGER CH, J, L, LINEND, MASK, R, S, WORD 00000190 00000191 EXTERNAL GET 00000192 00000193 L = R = 0 00000194 10 L = L + 1 00000195 CALL GET(WORD,STATUS) 00000196 IF (STATUS .NE. 0) GO TO 30 00000197 LINEND = WORD .AND. 7777B 00000198 DO 20 J=1, 10 00000199 WORD = ISHIFT(WORD,6) 00000200 IF ((WORD .AND. 77B) .EQ. 0) WORD = WORD .OR. 1R 00000201 20 CONTINUE 00000202 LINE(L) = WORD 00000203 IF (LINEND .EQ. 0) GO TO 40 00000204 IF (R .LT. RLENGTH) GO TO 10 00000205 GO TO 50 00000206 30 IF (R .EQ. 0) RETURN 00000207 40 IF (R .GE. RLENGTH) GO TO 50 00000208 L = L + 1 00000209 LINE(L) = 10H 00000210 R = R + 10 00000211 GO TO 40 00000212 50 STATUS = 0 00000213 CH = 6*(RLENGTH - (RLENGTH/10)*10) 00000214 IF (CH .EQ. 0) GO TO 60 00000215 MASK = ISHIFT(4000 0000 0000 0000 0000B,1-CH) 00000216 LINE(L) = LINE(L) .AND. MASK 00000217 IF (CH .LE. 48) RETURN 00000218 60 L = L + 1 00000219 LINE(L) = 0 00000220 RETURN 00000221 END 00000222 SUBROUTINE WAIT 00000223 COMMON /FILECTL/ FILE, F(8,1) 00000224 INTEGER F, FILE 00000225 INTEGER STATUS 00000226 EXTERNAL XRCL 00000227 10 STATUS = 1 00000228 FILE = 0 00000229 20 FILE = FILE + 1 00000230 IF (F(1,FILE) .EQ. 0) GO TO 30 00000231 ISTAT = F(1,FILE) .AND. 1 00000232 STATUS = STATUS * ISTAT 00000233 GO TO 20 00000234 30 IF (STATUS .EQ. 1) RETURN 00000235 CALL XRCL 00000236 GO TO 10 00000237 END 00000238 SUBROUTINE GET (WORD, STATUS) 00000239 00000240 INTEGER STATUS, WORD 00000241 COMMON / / LOCW, WSIZE, W(1) 00000242 INTEGER LOCW, W, WSIZE 00000243 INTEGER F, FILE 00000244 COMMON /FILECTL/ FILE, F(8,1) 00000245 C 00000246 C F(1,FILE) -- BA 00000247 C F(2,FILE) -- FIRST 00000248 C F(3,FILE) -- IN 00000249 C F(4,FILE) -- OUT 00000250 C F(5,FILE) -- LIMIT 00000251 C F(6,FILE) -- RECORD COUNT (COUNT OF -20B- STATUSES ENCOUNTERED) 00000252 C F(7,FILE) -- (UNUSED) 00000253 C F(8,FILE) -- (UNUSED) 00000254 C 00000255 00000256 INTEGER BUSY, LENGTH, OUT, STAT 00000257 EXTERNAL ERROR, XCIO, XRCL 00000258 00000259 00000260 00000261 C 00000262 C -IF- IN ' OUT -GO TO- 60 00000263 C 00000264 10 IF (F(3,FILE) .NE. F(4,FILE)) GO TO 60 00000265 00000266 C 00000267 C BUSY 0= BA .AND. 1 00000268 C 00000269 BUSY = F(1,FILE) .AND. 1 00000270 IF (BUSY .EQ. 1) GO TO 20 00000271 CALL XRCL 00000272 GO TO 10 00000273 00000274 C 00000275 C STAT 0= BA .AND. 70B 00000276 C 00000277 20 IF (STATUS .LT. 0) F(1,FILE) = F(1,FILE) .AND. 00000278 . 7777 7777 7777 7700 0003B 00000279 STATUS = 0 00000280 STAT = F(1,FILE) .AND. 70B 00000281 IF (STAT .NE. 20B .AND. STAT .NE. 30B) GO TO 40 00000282 STATUS = STAT 00000283 00000284 C 00000285 C -IF- STATUS = EOR -THEN- RECORD.COUNT 0= RECORD.COUNT + 1 00000286 C 00000287 30 IF (STATUS .EQ. 60B) CALL ERROR (30HATTEMPT TO READ UNLOADED FIL00000288 .E.) 00000289 IF (STATUS .EQ. 20B) F(6,FILE) = F(6,FILE) + 1 00000290 IF (STATUS .EQ. 20B .OR. STATUS .EQ. 30B) RETURN 00000291 CALL ERROR(24HMACHINE OR SYSTEM ERROR.) 00000292 00000293 00000294 C 00000295 C BA 0= FILENAME MODE READ.COMMAND 00000296C 00000297 40 F(1,FILE) = F(1,FILE) .AND. 7777 7777 7777 7700 0002B .OR. 10B00000298 00000299C 00000300 C CALL XCIO (BA) 00000301 C 00000302 CALL XCIO (F(1,FILE)) 00000303 50 CALL XRCL 00000304 00000305 C 00000306 C -IF- IN ' OUT -GO TO- 60 00000307 C 00000308 IF (F(3,FILE) .NE. F(4,FILE)) GO TO 60 00000309 00000310 C 00000311 C BUSY 0= BA .AND. 1 00000312 C 00000313 BUSY = F(1,FILE) .AND. 1 00000314 IF (BUSY .EQ. 0) GO TO 50 00000315 00000316 C 00000317 C -IF- IN ' OUT -GO TO- 60 00000318 C 00000319 IF (F(3,FILE) .NE. F(4,FILE)) GO TO 60 00000320 00000321 C 00000322 C STATUS 0= BA .AND. 70B 00000323 C 00000324 STATUS = F(1,FILE) .AND. 70B 00000325 GO TO 30 00000326 00000327 C 00000328 C WORD 0= W(OUT-LOCW+1) 00000329 C 00000330 60 STATUS = 0 00000331 IW = F(4,FILE) - LOCW + 1 00000332 WORD = W(IW) 00000333 00000334 C 00000335 C OUT 0= -IF- OUT + 1 = LIMIT -THEN- FIRST -ELSE- OUT + 1 00000336 C 00000337 OUT = F(4,FILE) + 1 00000338 IF (OUT .EQ. F(5,FILE)) OUT = F(2,FILE) 00000339 F(4,FILE) = OUT 00000340 00000341 C 00000342 C BUSY 0= BA .AND. 1 00000343 C 00000344 BUSY = F(1,FILE) .AND. 1 00000345 IF (BUSY .EQ. 0) RETURN 00000346 00000347 C 00000348 C STAT 0= BA .AND. 70B 00000349 C 00000350 STAT = F(1,FILE) .AND. 70B 00000351 IF (STAT .NE. 10B) RETURN 00000352 00000353 C 00000354 C LENGTH 0= -IF- OUT [ IN -THEN- OUT - IN 00000355 C -ELSE- LIMIT - FIRST + (OUT - IN) 00000356 C 00000357 LENGTH = F(4,FILE) - F(3,FILE) 00000358 IF (LENGTH .LT. 0) LENGTH = F(5,FILE) - F(2,FILE) + LENGTH 00000359 IF (LENGTH .LT. 65) RETURN 00000360 00000361 C 00000362 C BA 0= FILENAME MODE READ.COMMAND 00000363C 00000364 F(1,FILE) = F(1,FILE) .AND. 7777 7777 7777 7700 0002B .OR. 10B00000365 00000366C 00000367C CALL XCIO (BA) 00000368C 00000369 CALL XCIO (F(1,FILE)) 00000370 RETURN 00000371 END 00000372 SUBROUTINE ERROR (MSG) 00000373 00000374 COMMON /FILECTL/ FILE, F(8,1) 00000375 INTEGER F, FILE 00000376 CALL TIME(MSG) 00000377 CALL XRCL 00000378 CALL WAIT 00000379 FILE = 0 00000380 10 FILE = FILE + 1 00000381 IF (F(1,FILE) .NE. 0) GO TO 10 00000382 CALL DUMP(FILE,F(1,FILE),0) 00000383 END 00000384 SUBROUTINE PUT (WORD, STATUS) 00000385 00000386 INTEGER STATUS, WORD 00000387 COMMON / /LOCW, WSIZE, W(1) 00000388 INTEGER LOCW, W, WSIZE 00000389 COMMON /FILECTL/ FILE, F(8,1) 00000390 INTEGER F, FILE 00000391 00000392 INTEGER BUSY, IN, LENGTH 00000393 00000394 C 00000395 C F(1,FILE) -- BA 00000396 C F(2,FILE) -- FIRST 00000397 C F(3,FILE) -- IN 00000398 C F(4,FILE) -- OUT 00000399 C F(5,FILE) -- LIMIT 00000400 C F(6,FILE) -- RECORD COUNT (COUNT OF -20B- STATUSES ENCOUNTERED) 00000401 C F(7,FILE) -- (UNUSED) 00000402 C F(8,FILE) -- (UNUSED) 00000403 C 00000404 EXTERNAL ERROR, XCIO, XRCL 00000405 00000406 00000407 IF (STATUS .NE. 0) GO TO 50 00000408 00000409 C 00000410 C -IF- IN ' OUT-1 " (OUT ' FIRST ! IN ' LIMIT-1) -GO TO- 40 00000411 C 00000412 10 IF (F(3,FILE) .NE. F(4,FILE) - 1 .AND. 00000413 . (F(4,FILE) .NE. F(2,FILE) .OR. 00000414 . F(3,FILE) .NE. F(5,FILE) - 1) ) GO TO 40 00000415 00000416 C 00000417 C BUSY 0= BA .AND. 1 00000418 C 00000419 BUSY = F(1,FILE) .AND. 1 00000420 IF (BUSY .EQ. 1) GO TO 20 00000421 CALL XRCL 00000422 GO TO 10 00000423 00000424 C 00000425 C BA 0= FILENAME MODE WRITE.COMMAND 00000426C 00000427 20 F(1,FILE) = F(1,FILE) .AND. 7777 7777 7777 7700 0002B .OR. 14B00000428 00000429C 00000430 C CALL XCIO (BA) 00000431 C 00000432 CALL XCIO (F(1,FILE)) 00000433 30 CALL XRCL 00000434 00000435 C 00000436 C -IF- IN ' OUT-1 " (OUT ' FIRST ! IN ' LIMIT-1) -GO TO- 40 00000437 C 00000438 IF (F(3,FILE) .NE. F(4,FILE) - 1 .AND. 00000439 . (F(4,FILE) .NE. F(2,FILE) .OR. 00000440 . F(3,FILE) .NE. F(5,FILE) - 1) ) GO TO 40 00000441 00000442 C 00000443 C BUSY 0= BA .AND. 1 00000444 C 00000445 BUSY = F(1,FILE) .AND. 1 00000446 IF (BUSY .EQ. 0) GO TO 30 00000447 CALL ERROR (24HMACHINE OR SYSTEM ERROR.) 00000448 00000449 C 00000450 C W(IN-LOCW+1) 0= WORD 00000451 C 00000452 00000453 40 IW = F(3,FILE) - LOCW + 1 00000454 W(IW) = WORD 00000455 00000456 C 00000457 00000458 C IF 0= -IF- IN+1 = LIMIT -THEN- FIRST -ELSE- IN+ 1 00000459 C 00000460 IN = F(3,FILE) + 1 00000461 IF (IN .EQ. F(5,FILE)) IN = F(2,FILE) 00000462 F(3,FILE) = IN 00000463 00000464 C 00000465 C BUSY 0= BA .AND. 1 00000466 C 00000467 BUSY = F(1,FILE) .AND. 1 00000468 IF (BUSY .EQ. 0) RETURN 00000469 00000470 C 00000471 C LENGTH 0= -IF- IN ? OUT -THEN- LIMIT-FIRST + (IN-OUT) 00000472 C -ELSE- IN-OUT 00000473 C 00000474 LENGTH = F(3,FILE) - F(4,FILE) 00000475 IF (LENGTH .LT. 0) LENGTH = F(5,FILE) - F(2,FILE) + LENGTH 00000476 IF (LENGTH .LT. 64) RETURN 00000477 00000478 C 00000479 C BA 0= FILENAME MODE WRITE.COMMAND 00000480 C 00000481 F(1,FILE) = F(1,FILE) .AND. 7777 7777 7777 7700 0002B .OR. 14B00000482 00000483 C 00000484 C CALL XCIO (BA) 00000485 C 00000486 CALL XCIO (F(1,FILE)) 00000487 RETURN 00000488 00000489 50 IF (STATUS .EQ. 20B .OR. STATUS .EQ. 30B) GO TO 70 00000490 60 CALL ERROR (23HCALLING ARGUMENT ERROR.) 00000491 00000492 C 00000493 C BUSY 0= BA .AND. 1 00000494 C 00000495 70 BUSY = F(1,FILE) .AND. 1 00000496 IF (BUSY .EQ. 1) GO TO 80 00000497 CALL XRCL 00000498 GO TO 70 00000499 00000500 C 00000501 C BA 0= FILENAME MODE STATUS WRITE.COMMAND 00000502C 00000503 80 F(1,FILE) = F(1,FILE) .AND. 7777 7777 7777 7700 0002B .OR. 14B00000504 00000505C 00000506C CALL XCIO (BA) 00000507C 00000508 CALL XCIO (F(1,FILE)) 00000509 00000510 C -IF- STATUS=EOR -THEN- RECORD.COUNT 0= RECORD.COUNT + 1 00000511 C 00000512 IF (STATUS .EQ. 20B) F(6,FILE) = F(6,FILE) + 1 00000513 RETURN 00000514 END 00000515 SUBROUTINE PUT LINE (LINE, STATUS) 00000516 00000517 INTEGER LINE(1) 00000518 INTEGER STATUS 00000519 I = 1 00000520 IF (STATUS .EQ. 0) GO TO 10 00000521 CALL PUT(0,STATUS) 00000522 RETURN 00000523 10 CALL PUT(LINE(I),STATUS) 00000524 IEND = LINE(I) .AND. 7777B 00000525 IF (IEND .EQ. 0) RETURN 00000526 I = I + 1 00000527 GO TO 10 00000528 END 00000529 SUBROUTINE GETLINE (LINE,ISTAT) 00000530 00000531 INTEGER LINE(1) 00000532 I = 1 00000533 10 CALL GET (LINE(I), ISTAT) 00000534 IEND = LINE(I) .AND. 7777B 00000535 IF (IEND .EQ. 0) RETURN 00000536 IF (ISTAT .NE. 0) RETURN 00000537 I = I + 1 00000538 GO TO 10 00000539 END 00000540 SUBROUTINE GET E LIN (LINE,STATUS) 00000541 INTEGER LINE(1), ELINE(20) 00000542 INTEGER STATUS 00000543 CALL GET LINE(ELINE,STATUS) 00000544 IF (STATUS .NE. 0) RETURN 00000545 NE = 1 00000546 NL = 0 00000547 CALL INFLATE(ELINE,NE,LINE,NL) 00000548 RETURN 00000549 ENTRY PUT E LIN 00000550 IF (STATUS .NE. 0) GO TO 10 00000551 NE = 0 00000552 NL = 1 00000553 CALL DEFLATE (ELINE,NE,LINE,NL) 00000554 10 CALL PUT LINE(ELINE,STATUS) 00000555 RETURN 00000556 END 00000557 SUBROUTINE INFLATE (SQUOZE, NQ, SPREAD, NP) 00000558 00000559 00000560 INTEGER SPREAD(1), SQUOZE(1) 00000561 INTEGER CH, CHIN, CHOUT, WDIN, WDOUT 00000562 00000563 00000564 WDIN = (NQ - 1)/10 + 1 00000565 CHIN = 6*(MOD(NQ-1,10) + 1) 00000566 WDOUT = NP/10 + 1 00000567 CHOUT = 6*(9 - MOD(NP,10)) 00000568 SPREAD(WDOUT) = SPREAD(WDOUT) .AND. .NOT. 00000569 . (ISHIFT(ISHIFT(40000 00000 00000 00000B,-CHOUT-5)00000570 . ,CHOUT+6)) 00000571 00000572 10 CH = ISHIFT(SQUOZE(WDIN),CHIN) .AND. 77B 00000573 NQ = NQ + 1 00000574 CHIN = CHIN + 6 00000575 IF (CHIN .LE. 60) GO TO 20 00000576 WDIN = WDIN + 1 00000577 CHIN = 6 00000578 20 IF (CH .EQ. 00B) RETURN 00000579 SPREAD(WDOUT) = SPREAD(WDOUT) .OR. ISHIFT(CH,CHOUT) 00000580 NP = NP + 1 00000581 CHOUT = CHOUT - 6 00000582 IF (CHOUT .GE. 0) GO TO 30 00000583 WDOUT = WDOUT + 1 00000584 SPREAD(WDOUT) = 0 00000585 CHOUT = 54 00000586 30 IF (CH .NE. 1R ) GO TO 10 00000587 CH = ISHIFT(SQUOZE(WDIN),CHIN) .AND. 77B 00000588 NQ = NQ + 1 00000589 CHIN = CHIN + 6 00000590 IF (CHIN .LE. 60) GO TO 40 00000591 WDIN = WDIN + 1 00000592 CHIN = 6 00000593 40 IF (CH .EQ. 0) GO TO 10 00000594 CH = CH - 1 00000595 SPREAD(WDOUT) = SPREAD(WDOUT) .OR. ISHIFT(1R ,CHOUT) 00000596 NP = NP + 1 00000597 CHOUT = CHOUT - 6 00000598 IF (CHOUT .GE. 0) GO TO 40 00000599 WDOUT = WDOUT + 1 00000600 SPREAD(WDOUT) = 0 00000601 CHOUT = 54 00000602 GO TO 40 00000603 00000604 ENTRY DEFLATE 00000605 WDIN = (NP - 1)/10 + 1 00000606 CHIN = 6*(MOD(NP-1,10) + 1) 00000607 WDOUT = NQ/10 + 1 00000608 CHOUT = 6*(9 - MOD(NQ,10)) 00000609 SQUOZE(WDOUT) = SQUOZE(WDOUT) .AND. .NOT. 00000610 . (ISHIFT(ISHIFT(40000 00000 00000 00000B,-CHOUT-5)00000611 . ,CHOUT+6)) 00000612 50 CH = ISHIFT(SPREAD(WDIN),CHIN) .AND. 77B 00000613 NP = NP + 1 00000614 CHIN = CHIN + 6 00000615 IF (CHIN .LE. 60) GO TO 70 00000616 WDIN = WDIN + 1 00000617 CHIN = 6 00000618 70 SQUOZE(WDOUT) = SQUOZE(WDOUT) .OR. ISHIFT(CH,CHOUT) 00000619 NQ = NQ + 1 00000620 CHOUT = CHOUT - 6 00000621 IF (CHOUT .GE. 0) GO TO 80 00000622 WDOUT = WDOUT + 1 00000623 SQUOZE(WDOUT) = 0 00000624 CHOUT = 54 00000625 80 IF (CH .EQ. 00B) RETURN 00000626 IF (CH .NE. 1R ) GO TO 50 00000627 I = 0 00000628 90 CH = ISHIFT(SPREAD(WDIN),CHIN) .AND. 77B 00000629 NP = NP + 1 00000630 CHIN = CHIN + 6 00000631 IF (CHIN .LE. 60) GO TO 100 00000632 WDIN = WDIN + 1 00000633 CHIN = 6 00000634 100 IF (I .EQ. 63) GO TO 110 00000635 IF (CH .NE. 1R ) GO TO 110 00000636 I = I + 1 00000637 GO TO 90 00000638 110 SQUOZE(WDOUT) = SQUOZE(WDOUT) .OR. ISHIFT(I,CHOUT) 00000639 NQ = NQ + 1 00000640 CHOUT = CHOUT - 6 00000641 IF (CHOUT .GE. 0) GO TO 70 00000642 WDOUT = WDOUT + 1 00000643 SQUOZE(WDOUT) = 0 00000644 CHOUT = 54 00000645 GO TO 70 00000646 END 00000647 ASCENT SHIFTY 00000648 ENTRY ISHIFT,SHIFT 00000649 ISHIFT JP * ENTRY/EXIT LINE 00000650 SHIFT EQU ISHIFT (SAME FOR REAL OR INTEGER) 00000651 SA1 B1 FETCH WORD TO BE SHIFTED 00000652 SA2 B2 FETCH SHIFT COUNT 00000653 SB2 X2 PLACE SHIFT COUNT INTO B REGISTER 00000654 LX6 X1,B2 SHIFT WORD INTO RESULT REGISTER 00000655 ZR ISHIFT 00000656 END 00000657 ASCENT INTER 00000658 ENTRY XRCL,XCIO 00000659 ENTRY IGETFL 00000660 XRCL JP * 00000661 WAIT1 SA1 1 00000662 NZ X1,WAIT1 00000663 SX6 220314B 00000664 LX6 42 00000665 SA6 A1 00000666 WAIT2 SA1 A1 00000667 NZ X1,WAIT2 00000668 ZR XRCL 00000669 XCIO JP * 00000670 SX6 031117B 00000671 LX6 42 00000672 SX1 B1 00000673 BX6 X1+X6 00000674 WAIT SA1 1 00000675 NZ X1,WAIT 00000676 SA6 A1 00000677 ZR XCIO 00000678 IGETFL JP * 00000679 SX6 A0 00000680 ZR IGETFL 00000681 END 00000682 00000673