projects / pdp8.git / blob
? search:


6c4ee6610c64f78d14ea2617c4b73a8923505cdf
[pdp8.git] / sw / kermit / k12 / k12enc.pal
1 / OS/8 ENCODING PROGRAM
2
3 / LAST EDIT: 08-JUL-1992 22:00:00 CJL
4
5 / MUST BE ASSEMBLED WITH '/F' SWITCH SET.
6
7 / PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE").
8
9 / DISTRIBUTED BY CUCCA AS "K12ENC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE.
10
11 / WRITTEN BY:
12
13 / CHARLES LASNER (CJL)
14 / CLA SYSTEMS
15 / 72-55 METROPOLITAN AVENUE
16 / MIDDLE VILLAGE, NEW YORK 11379-2107
17 / (718) 894-6499
18
19 / USAGE:
20
21 / .RUN DEV ENCODE INVOKE PROGRAM
22 / *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
23 / *OUTPUT<DEV:=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD
24 / 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN VALUE MUST BE
25 / STATED PRECISELY TO TRANSFER THE REQUISITE AMOUNT OF
26 / THE DEVICE AS REQUIRED. THE VALUE IS GENERALLY THE
27 / TOTAL LENGTH OF THE DEVICE, BUT COULD BE LESS AS
28 / NECESSARY; LARGER VALUES WILL GENERALLY FAIL. THIS
29 / MODE SHOULD ONLY BE USED TO EFFECT TRANSFER OF
30 / COMPLETE DEVICE IMAGES WHERE THE NORMAL OS/8 FILE
31 / STRUCTURE IS UNSUITABLE. IN THIS MODE, THE OS/8 FILE
32 / (POSSIBLY PRESENT) ON THE DEVICE IS IGNORED. ****
33 / NOTE **** THIS METHOD VIOLATES ALL OS/8 DEVICE
34 / STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE
35 / IMAGES ONLY; USE WITH CARE!
36 / *OUTPUT<DEV:=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
37 / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
38 / USED. THE DECODER MUST BE GIVEN THE EQUIVALENT
39 / PARAMETERS TO TRANSFER THE FIRST HALF.
40 / *OUTPUT<DEV:=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
41 / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
42 / USED. NOTE THAT THERE MUST BE TWO FILES CREATED, ONE
43 / USING /I/1 AND THE OTHER USING /I/2 TO COMPLETELY
44 / TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE!
45 / *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
46 / . PROGRAM EXITS NORMALLY
47
48 / INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. IF
49 / IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION; ONLY A DEVICE IS
50 / GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH.
51
52 / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
53 / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
54 / CHARACTER.
55 \f/ THIS PROGRAM SUPPORTS A SUBSET OF THE ASCII FILE ENCODING SCHEME DEVELOPED BY
56 / CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING WITH
57 / COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
58 / VERSIONS).
59
60 / RESTRICTIONS:
61
62 / A) NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE.
63
64 / B) CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE.
65
66 / C) CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER.
67
68 / D) THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE IDENTICAL TO
69 / THE ACTUAL INVOKED INPUT FILE. THE USER MUST SEPARATELY MODIFY THESE
70 / COMMANDS WHEN EXPORTING THE ENCODED FILE TO A SYSTEM WITH DIFFERENT
71 / NAMING CONVENTIONS.
72
73 / ERROR MESSAGES.
74
75 / ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER
76 / (PROGRAM-SIGNALLED) MESSAGES.
77
78 / COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE
79 / COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND
80 / DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER
81 / PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
82 / THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
83 / THIS UTILITY PROGRAM.
84
85 / ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
86 / THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8
87 / "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE
88 / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
89 / THE FOLLOWING USER ERRORS ARE DEFINED:
90
91 / ERROR NUMBER PROBABLE CAUSE
92
93 / 0 NO OUTPUT FILE.
94
95 / 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT
96 / FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
97 / 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
98
99 / 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
100
101 / 4 ERROR WHILE FETCHING FILE HANDLER.
102
103 / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
104
105 / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
106
107 / 7 ERROR WHILE CLOSING THE OUTPUT FILE.
108
109 / 8 I/O ERROR WHILE ENCODING FILE DATA.
110 \f/ ASSEMBLY INSTRUCTIONS.
111
112 / IT IS ASSUMED THE SOURCE FILE K12ENC.PAL HAS BEEN MOVED AND RENAMED TO
113 / DSK:ENCODE.PA.
114
115 / .PAL ENCODE<ENCODE/E/F ASSEMBLE SOURCE PROGRAM
116 / .LOAD ENCODE LOAD THE BINARY FILE
117 / .SAVE DEV ENCODE=2001 SAVE THE CORE-IMAGE FILE
118 \f/ DEFINITIONS.
119
120 AIWCNT= 1404 /ADDITIONAL INFORMATION WORDS COUNT HERE
121 AIWXR= 0017 /POINTER TO ADDITIONAL INFORMATION WORDS
122 CLOSE= 4 /CLOSE OUTPUT FILE
123 DATEXT= 7777 /DATE EXTENSION HERE
124 DATWRD= 7666 /OS/8 DATE WORD
125 DECODE= 5 /CALL COMMAND DECODER
126 ENTER= 3 /ENTER TENTATIVE FILE
127 EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD
128 FETCH= 1 /FETCH HANDLER
129 IHNDBUF=7200 /INPUT HANDLER BUFFER
130 INBUFFE=6200 /INPUT BUFFER
131 INFILE= 7605 /INPUT FILE INFORMATION HERE
132 LOOKUP= 2 /LOOKUP INPUT FILE
133 NL0001= CLA IAC /LOAD AC WITH 0001
134 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
135 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
136 NL7777= CLA CMA /LOAD AC WITH 7777
137 OHNDBUF=6600 /OUTPUT HANDLER BUFFER
138 OUTBUFF=5600 /OUTPUT BUFFER
139 OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
140 PRGFLD= 00 /PROGRAM FIELD
141 RESET= 13 /RESET SYSTEM TABLES
142 REVISIO=1 /PROGRAM REVISION
143 SBOOT= 7600 /MONITOR EXIT
144 SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD
145 SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD
146 TBLFLD= 10 /COMMAND DECODER TABLE FIELD
147 TERMWRD=7642 /TERMINATOR WORD
148 USERROR=7 /USER SIGNALLED ERROR
149 USR= 0200 /USR ENTRY POINT
150 USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT
151 USRFLD= 10 /USR FIELD
152 USRIN= 10 /LOCK USR IN CORE
153 VERSION=2 /PROGRAM VERSION
154 WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71)
155 WRITE= 4000 /I/O WRITE BIT
156 \f *0 /START AT THE BEGINNING
157
158 *10 /DEFINE AUTO-INDEX AREA
159
160 XR1, .-. /AUTO-INDEX NUMBER 1
161 XR2, .-. /AUTO-INDEX NUMBER 2
162
163 *20 /GET PAST AUTO-INDEX AREA
164
165 BUFPTR, .-. /OUTPUT BUFFER POINTER
166 CCNT, .-. /CHECKSUM COUNTER
167 CHKFLG, .-. /CHECKSUMMING ALLOWED FLAG
168 CHKSUM, ZBLOCK 5 /CHECKSUM
169 CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
170 DANGCNT,.-. /DANGER COUNT
171 FDATE, .-. /FILE DATE
172 FILLVAL,.-. /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
173 IDNUMBE,.-. /INPUT DEVICE NUMBER
174 IFNAME, ZBLOCK 4 /INPUT FILENAME
175 IMSW, .-. /IMAGE-MODE SWITCH
176 INLEN, .-. /INPUT FILE LENGTH
177 INPTR, .-. /INPUT BUFFER POINTER
178 INPUT, .-. /INPUT HANDLER POINTER
179 INRECOR,.-. /INPUT RECORD
180 FNAME, ZBLOCK 4 /OUTPUT FILENAME
181 LATEST, .-. /LATEST OUTPUT CHARACTER
182 OBOUND, .-. /OUTPUT BOUNDARY COUNTER
183 OCTCNT, .-. /OCTAL OUTPUT ROUTINE COUNTER
184 OCTEMP, .-. /OCTAL OUTPUT ROUTINE TEMPORARY
185 ODNUMBE,.-. /OUTPUT DEVICE NUMBER
186 OUTPUT, .-. /OUTPUT HANDLER POINTER
187 OUTRECO,.-. /OUTPUT RECORD
188 PRTEMP, .-. /DATE OUTPUT TEMPORARY
189 PUTEMP, .-. /OUTPUT TEMPORARY
190 PUTLATE,.-. /LATEST 5-BIT CHARACTER
191 PUTPREV,.-. /PREVIOUS OUTPUT TEMPORARY
192 QUO, .-. /DIVIDE QUOTIENT
193 REM, .-. /DIVIDE REMAINDER
194 SCRCASE,.-. /CURRENT MESSAGE CASE
195 SCRCHAR,.-. /LATEST MESSAGE CHARACTER
196 SCRPTR, .-. /MESSAGE POINTER
197 TDATE, .-. /TODAY'S DATE
198 TEMP, .-. /TEMPORARY
199 TEMPTR, .-. /TEMPORARY OUTPUT POINTER
200 WIDCNT, .-. /LINE WIDTH COUNTER
201 \f PAGE /START AT THE USUAL PLACE
202
203 BEGIN, NOP /IN CASE WE'RE CHAINED TO
204 CLA /CLEAN UP
205 START, CIF USRFLD /GOTO USR FIELD
206 JMS I (USRENTRY) /CALL USR ROUTINE
207 USRIN /GET IT LOCKED IN
208 CIF USRFLD /GOTO USR FIELD
209 JMS I [USR] /CALL USR ROUTINE
210 DECODE /WANT COMMAND DECODER
211 "*^100 /USING SPECIAL MODE
212 CDF TBLFLD /GOTO TABLE FIELD
213 TAD I (TERMWRD) /GET TERMINATOR WORD
214 SPA CLA /SKIP IF <CR> TERMINATED THE LINE
215 DCA EXITZAP /ELSE CAUSE EXIT LATER
216 DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
217 TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD
218 SNA /SKIP IF OUTPUT FILE PRESENT
219 JMP TSTMORE /JUMP IF NOT THERE
220 AND [17] /JUST DEVICE BITS
221 DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
222 TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
223 SNA /SKIP IF PRESENT
224 JMP INERR /JUMP IF NOT
225 AND [17] /JUST DEVICE BITS
226 DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
227 TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD
228 SZA CLA /SKIP IF ONLY ONE INPUT FILE
229 JMP INERR /ELSE COMPLAIN
230 JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
231 TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
232 SNA CLA /SKIP IF NAME PRESENT
233 JMP NONAMERROR /JUMP IF DEVICE ONLY
234 JMS I (MOFNAME) /MOVE OUTPUT FILENAME
235 CDF PRGFLD /BACK TO OUR FIELD
236 CIF USRFLD /GOTO USR FIELD
237 JMS I [USR] /CALL USR ROUTINE
238 RESET /RESET SYSTEM TABLES
239 TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
240 DCA OHPTR /STORE IN-LINE
241 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
242 CIF USRFLD /GOTO USR FIELD
243 JMS I [USR] /CALL USR ROUTINE
244 FETCH /FETCH HANDLER
245 OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
246 JMP FERROR /FETCH ERROR
247 TAD OHPTR /GET RETURNED ADDRESS
248 DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
249 TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
250 DCA IHPTR /STORE IN-LINE
251 \f TAD IDNUMBER /GET INPUT DEVICE NUMBER
252 CIF USRFLD /GOTO USR FIELD
253 JMS I [USR] /CALL USR ROUTINE
254 FETCH /FETCH HANDLER
255 IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
256 JMP FERROR /FETCH ERROR
257 TAD IHPTR /GET RETURNED ADDRESS
258 DCA INPUT /STORE AS INPUT HANDLER ADDRESS
259 TAD IMSW /GET IMAGE-MODE SWITCH
260 SNA CLA /SKIP IF IMAGE MODE SET
261 JMS I (GEIFILE) /GO LOOKUP INPUT FILE
262 TAD (FNAME) /POINT TO
263 DCA ENTAR1 /STORED FILENAME
264 DCA ENTAR2 /CLEAR SECOND ARGUMENT
265 JMS I (INDATE) /GET INPUT FILE'S DATE
266 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
267 CIF USRFLD /GOTO USR FIELD
268 JMS I [USR] /CALL USR ROUTINE
269 ENTER /ENTER TENTATIVE FILENAME
270 ENTAR1, .-. /WILL POINT TO FILENAME
271 ENTAR2, .-. /WILL BE ZERO
272 JMP ENTERR /ENTER ERROR
273 TAD ENTAR1 /GET RETURNED FIRST RECORD
274 DCA OUTRECORD /STORE IT
275 TAD ENTAR2 /GET RETURNED EMPTY LENGTH
276 IAC /ADD 2-1 FOR OS/278 CRAZINESS
277 DCA DANGCNT /STORE AS DANGER COUNT
278 JMS I (CLRCHKSUM) /CLEAR THE CHECKSUM
279 JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING
280 JMP PROCERR /ERROR WHILE ENCODING
281 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
282 CIF USRFLD /GOTO USR FIELD
283 JMS I [USR] /CALL USR ROUTINE
284 CLOSE /CLOSE OUTPUT FILE
285 FNAME /POINTER TO FILENAME
286 OUTCNT, .-. /WILL BE ACTUAL COUNT
287 JMP CLSERR /CLOSE ERROR
288 EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
289 JMP I (SBOOT) /EXIT TO MONITOR
290 \f/ ERROR WHILE PROCESSING INPUT FILE.
291
292 PROCERR,NL0002 /SET INCREMENT
293 SKP /DON'T USE NEXT
294
295 / ERROR WHILE CLOSING THE OUTPUT FILE.
296
297 CLSERR, NL0001 /SET INCREMENT
298 SKP /DON'T CLEAR IT
299
300 / OUTPUT FILE TOO LARGE ERROR.
301
302 SIZERR, CLA /CLEAN UP
303 TAD [3] /SET INCREMENT
304 SKP /DON'T USE NEXT
305
306 / ENTER ERROR.
307
308 ENTERR, NL0002 /SET INCREMENT
309 SKP /DON'T USE NEXT
310
311 / HANDLER FETCH ERROR.
312
313 FERROR, NL0001 /SET INCREMENT
314
315 / NO OUTPUT FILENAME ERROR.
316
317 NONAMER,IAC /SET INCREMENT
318
319 / ILLEGAL OUTPUT FILE NAME ERROR.
320
321 BADNAME,IAC /SET INCREMENT
322
323 / INPUT FILESPEC ERROR.
324
325 INERR, IAC /SET INCREMENT
326
327 / OUTPUT FILESPEC ERROR.
328
329 OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
330 CDF PRGFLD /ENSURE OUR FIELD
331 CIF USRFLD /GOTO USR FIELD
332 JMS I [USR] /CALL USR ROUTINE
333 USERROR /USER ERROR
334 ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
335
336 / COMES HERE TO TEST FOR NULL LINE.
337
338 TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
339 SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN
340 JMP OUTERR /ELSE COMPLAIN
341 CDF PRGFLD /BACK TO OUR FIELD
342 JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
343 \f PAGE
344 \fENCODIT,.-. /ENCODING ROUTINE
345 TAD INRECORD /GET INPUT FILE STARTING RECORD
346 DCA INREC /STORE IN-LINE
347 NL7777 /SETUP INITIALIZE VALUE
348 JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE
349 JMS I (TDMESSAGE) /OUTPUT TODAY'S DATE MESSAGE
350 JMS I (FDMESSAGE) /OUTPUT FILE DATE MESSAGE
351 JMS I [SCRIBE] /OUTPUT THE
352 FILMSG /(FILE MESSAGE
353 JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
354 JMS I [SCRIBE] /OUTPUT THE
355 EMSG /LINE ENDING
356 TAD [-WIDTH] /SETUP THE
357 DCA WIDCNT /LINE WIDTH COUNTER
358 JMS I (OUTSETUP) /SETUP PACKING ROUTINE AND CLEAR FILL
359 TAD [-5] /INITIALIZE
360 DCA OBOUND /BOUNDARY COUNTER
361 ENCLOOP,JMS I INPUT /CALL INPUT HANDLER
362 2^100 /READ TWO PAGES
363 PINBUFF,INBUFFER /INTO INPUT BUFFER
364 INREC, .-. /WILL BE LATEST INPUT FILE RECORD
365 ENCERRO,JMP I ENCODIT /INPUT ERROR, TAKE IMMEDIATE RETURN
366 ISZ INREC /BUMP TO NEXT RECORD
367 NOP /JUST IN CASE
368 TAD PINBUFFER/(INBUFFER) /SETUP THE
369 DCA INPTR /BUFFER POINTER
370 LOOP, JMS I (CHKBND) /CHECK IF ON A GOOD BOUNDARY
371 JMP NOCOMPRESSION /COMPRESS IS NOT ALLOWED AT THIS TIME
372 TAD INPTR /GET CURRENT POINTER
373 DCA XR1 /STASH FOR SEARCH
374 DCA CMPCNT /CLEAR MATCH COUNT
375 CMPLUP, TAD XR1 /GET INDEX VALUE
376 TAD (-2^200-INBUFFER+1) /COMPARE TO LIMIT
377 SNA CLA /SKIP IF NOT AT END OF BUFFER
378 JMP CMPEND /JUMP IF AT END OF BUFFER
379 TAD I XR1 /GET A CANDIDATE WORD
380 CIA /INVERT FOR TEST
381 TAD I INPTR /COMPARE TO CURRENT TEST VALUE
382 SZA CLA /SKIP IF IT MATCHES
383 JMP CMPEND /JUMP IF THIS IS NOT A REPEAT
384 ISZ CMPCNT /BUMP MATCH COUNT
385 JMP CMPLUP /TRY TO FIND MORE
386 \f/ COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED.
387
388 CMPEND, NL7776 /-2
389 TAD CMPCNT /DID WE FIND ENOUGH MATCHES?
390 SPA CLA /SKIP IF SO
391 JMP NOCOMPRESSION /FORGET IT
392 TAD ("X-"0) /SETUP COMPRESSION INDICATOR
393 JMS I (OUTSETUP) /SETUP SPECIAL MODE
394 JMS I (PUT5) /OUTPUT "X"
395 JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
396 TAD I INPTR /GET THE VALUE
397 JMS I [PUTIT] /OUTPUT IT
398 ISZ CMPCNT /ACCOUNT FOR ORIGINAL
399 TAD CMPCNT /GET COMPRESSION COUNT
400 CLL RTL;RTL /*16
401 JMS I [PUTIT] /OUTPUT BITS[0-7] ONLY
402 JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE AGAIN
403 TAD INPTR /GET INPUT POINTER
404 TAD CMPCNT /UPDATE PAST ALL COMPRESSED VALUES
405 DCA INPTR /STORE BACK
406 JMP TEST /CONTINUE THERE
407
408 / COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED).
409
410 NOCOMPR,TAD I INPTR /GET LATEST VALUE
411 JMS I [PUTIT] /OUTPUT IT
412 ISZ INPTR /BUMP TO NEXT
413 ISZ OBOUND /BUMP TO NEXT WORD
414 JMP TEST /KEEP GOING
415 TAD [-5] /RESET THE
416 DCA OBOUND /BOUNDARY COUNTER
417 TEST, TAD INPTR /GET INPUT POINTER
418 TAD (-2^200-INBUFFER) /COMPARE TO UPPER LIMIT
419 SZA CLA /SKIP IF AT END OF BUFFER
420 JMP LOOP /ELSE JUST KEEP GOING
421 ISZ INLEN /DONE ALL INPUT RECORDS?
422 JMP ENCLOOP /NO, KEEP GOING
423
424 / WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE.
425
426 ENDLUP, JMS I (CHKBND) /AT A GOOD BOUNDARY?
427 SKP /SKIP IF NOT
428 JMP ENDONE /JUMP IF SO
429 JMS I [PUTIT] /OUTPUT SOME WASTE BYTES
430 ISZ OBOUND /AT A GOOD BOUNDARY NOW?
431 JMP ENDLUP /NO, TRY AGAIN
432 \fENDONE, TAD ("Z-"0) /GET END INDICATOR
433 JMS I (OUTSETUP) /SETUP SPECIAL MODE
434 JMS I (PUT5) /OUTPUT A "Z"
435 JMS I (INVCHKSUM) /INVERT THE CHECKSUM
436 JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE
437 JMS I (CHKOUT) /OUTPUT THE CHECKSUM
438 JMS I [SCRIBE] /OUTPUT THE
439 ENDMSG /END MESSAGE
440 JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
441 JMS I [SCRIBE] /OUTPUT THE
442 EMSG /LINE ENDING
443 JMS I [SCRIBE] /OUTPUT THE
444 EOFMSG /FINAL MESSAGE
445 TAD ("Z&37) /GET <^Z>
446 CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL)
447 TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
448 TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
449 SZA CLA /SKIP IF IT MATCHES
450 JMP CLOSLUP /ELSE KEEP GOING
451 ISZ ENCODIT /NO ERRORS
452 JMP I ENCODIT /RETURN
453
454 PAGE
455 \fPUTIT, .-. /WORD OUTPUT ROUTINE
456 DCA PUTEMP /SAVE PASSED VALUE
457 JMS I (CALCHKSUM) /UPDATE CHECKSUM
458 JMP I PUTNXT /GO WHERE YOU SHOULD GO
459
460 PUTNXT, PUT0 /OUTPUT EXIT ROUTINE
461 TAD PUTEMP /GET LATEST VALUE
462 DCA PUTPREV /SAVE FOR NEXT TIME
463 JMP I PUTIT /RETURN TO MAIL CALLER
464
465 PUTLUP, JMS PUTNXT /GET ANOTHER WORD
466 PUT0, TAD PUTEMP /GET WORD[0]
467 RTL;RTL;RTL /BITS[0-4] => AC[7-11]
468 JMS PUT5 /OUTPUT A CHARACTER
469 TAD PUTEMP /GET WORD[0] AGAIN
470 RTR /BITS[5-9] => AC[7-11]
471 JMS PUT5 /OUTPUT A CHARACTER
472 JMS PUTNXT /GET ANOTHER WORD
473 PUT1, TAD PUTPREV /GET WORD[0]
474 AND [3] /ISOLATE BITS[10-11]
475 CLL RTL;RAL /BITS[10-11] => AC[7-8]
476 DCA PUTPREV /SAVE FOR NOW
477 TAD PUTEMP /GET WORD[1]
478 RTL;RTL /BITS[0-2] => AC[9-11]
479 AND [7] /ISOLATE DESIRED BITS
480 TAD PUTPREV /ADD ON WORD[0] BITS IN AC[7-8]
481 JMS PUT5 /OUTPUT A CHARACTER
482 TAD PUTEMP /GET WORD[1]
483 RTR;RTR /BITS[3-7] => AC[7-11]
484 JMS PUT5 /OUTPUT A CHARACTER
485 JMS PUTNXT /GET ANOTHER WORD
486 PUT2, TAD PUTEMP /GET WORD[2]
487 RAL /BIT[0] => L
488 CLA /CLEAN UP
489 TAD PUTPREV /GET WORD[1]
490 RAL /BITS[8-11],L => AC[7-11]
491 JMS PUT5 /OUTPUT A CHARACTER
492 TAD PUTEMP /GET WORD[2]
493 RTR;RTR;RTR /BITS[1-5] => AC[7-11]
494 JMS PUT5 /OUTPUT A CHARACTER
495 TAD PUTEMP /GET WORD[2]
496 RAR /BITS[6-10] => AC[7-11]
497 JMS PUT5 /OUTPUT A CHARACTER
498 JMS PUTNXT /GET ANOTHER WORD
499 \fPUT3, TAD PUTPREV /GET WORD[2]
500 RAR /BIT[11] => L
501 CLA /CLEAN UP
502 TAD PUTEMP /GET WORD[3]
503 RTL;RTL;RAL /L, BITS[0-3] => AC[7-11]
504 JMS PUT5 /OUTPUT A CHARACTER
505 TAD PUTEMP /GET WORD[3]
506 RTR;RAR /BITS[4-8] => AC[7-11]
507 JMS PUT5 /OUTPUT A CHARACTER
508 JMS PUTNXT /GET ANOTHER WORD
509 PUT4, TAD PUTPREV /GET WORD[3]
510 AND [7] /ISOLATE BITS[9-11]
511 CLL RTL /BITS[9-11] => AC[7-9]
512 DCA PUTPREV /SAVE FOR NOW
513 TAD PUTEMP /GET WORD[4]
514 RTL;RAL /BITS[0-1] => AC[10-11]
515 AND [3] /ISOLATE BITS[10-11]
516 TAD PUTPREV /ADD ON WORD[3] BITS IN AC[7-9]
517 JMS PUT5 /OUTPUT A CHARACTER
518 TAD PUTEMP /GET WORD[4]
519 RTR;RTR;RAR /BITS[2-6] => AC[7-11]
520 JMS PUT5 /OUTPUT A CHARACTER
521 TAD PUTEMP /GET WORD[4] BITS[7-11] IN AC[7-11]
522 JMS PUT5 /OUTPUT A CHARACTER
523 JMP PUTLUP /GO DO ANOTHER GROUP OF FIVE WORDS
524
525 CHKNL, .-. /CHECK IF AT NEW LINE ROUTINE
526 TAD WIDCNT /GET LINE WIDTH COUNTER
527 TAD (WIDTH) /COMPARE TO MAXIMIM VALUE
528 SZA CLA /SKIP IF AT MAXIMUM
529 ISZ CHKNL /TAKE SKIP RETURN IF NOT AT MAXIMUM
530 JMP I CHKNL /RETURN EITHER WAY
531
532 OUTSETU,.-. /OUTPUT SETUP ROUTINE
533 DCA FILLVALUE /STORE PASSED FILL VALUE
534 TAD (PUT0) /SETUP THE
535 DCA PUTNXT /OUTPUT CO-ROUTINE
536 JMP I OUTSETUP /RETURN
537 \fPUT5, .-. /FIVE-BIT OUTPUT ROUTINE
538 AND [37] /JUST 5 BITS
539 DCA PUTLATEST /SAVE IT
540 JMS CHKNL /CHECK IF AT BEGINNING OF LINE
541 SKP /SKIP IF NOT
542 JMP PUTNORMAL /JUMP IF SO
543 TAD ("<&177) /GET BEGINNING BRACKET
544 JMS I [DOBYTE] /OUTPUT IT
545 PUTNORM,TAD PUTLATEST /GET LATEST VALUE
546 TAD ("0-"9-1) /COMPARE TO FIRST LIMIT
547 SMA CLA /SKIP IF LESS
548 TAD ["A-"9-1] /CONVERT LARGER VALUES TO A-V
549 TAD PUTLATEST /ADD ON LATEST VALUE
550 TAD ["0&177] /MAKE IT ASCII
551 TAD FILLVALUE /ADD ON FILL VALUE FOR SPECIAL MODE
552 JMS I [DOBYTE] /OUTPUT IT
553 ISZ WIDCNT /BUMP LINE COUNTER
554 TAD WIDCNT /GET LINE COUNTER
555 SZA CLA /SKIP IF AT END OF LINE
556 JMP I PUT5 /ELSE JUST RETURN
557 TAD (">&177) /GET DATA CLOSING CHARACTER
558 JMS I [DOBYTE] /OUTPUT IT
559 TAD ["M&37] /GET A <CR>
560 JMS I [DOBYTE] /OUTPUT IT
561 TAD ["J&37] /GET A <LF>
562 JMS I [DOBYTE] /OUTPUT IT
563 TAD [-WIDTH] /RESET THE
564 DCA WIDCNT /LINE WIDTH COUNTER
565 JMP I PUT5 /RETURN
566
567 PAGE
568 \f/ MESSAGE PRINT ROUTINE.
569
570 SCRIBE, .-. /MESSAGE PRINT ROUTINE
571 TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT
572 DCA SCRPTR /STASH THE POINTER
573 ISZ SCRIBE /BUMP PAST ARGUMENT
574 TAD (140) /INITIALIZE TO
575 DCA SCRCASE /LOWER-CASE
576 SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD
577 RTR;RTR;RTR /MOVE OVER
578 JMS SCRPRNT /PRINT IT
579 TAD I SCRPTR /GET RIGHT HALF-WORD
580 JMS SCRPRNT /PRINT IT
581 ISZ SCRPTR /BUMP TO NEXT PAIR
582 JMP SCRLUP /KEEP GOING
583
584 SCRPRNT,.-. /CHARACTER PRINT ROUTINE
585 AND [77] /JUST SIX BITS
586 SNA /END OF MESSAGE?
587 JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER
588 DCA SCRCHAR /NO, SAVE FOR NOW
589 TAD SCRCHAR /GET IT BACK
590 TAD (-"%!200) /IS IT "%"?
591 SNA /SKIP IF NOT
592 JMP SCRCRLF /JUMP IF IT MATCHES
593 TAD (-"^+100+"%) /IS IT "^"
594 SNA CLA /SKIP IF NOT
595 JMP SCRFLIP /JUMP IF IT MATCHES
596 TAD SCRCHAR /GET THE CHARACTER
597 AND [40] /DOES CASE MATTER?
598 SNA CLA /SKIP IF NOT
599 TAD SCRCASE /ELSE GET PREVAILING CASE
600 TAD SCRCHAR /GET THE CHARACTER
601 SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER
602 JMP I SCRPRNT /RETURN
603
604 SCRCRLF,TAD ["M&37] /GET A <CR>
605 JMS I [DOBYTE] /OUTPUT IT
606 TAD ["J&37] /GET A <LF>
607 JMP SCRPRLF /CONTINUE THERE
608
609 SCRFLIP,TAD SCRCASE /GET CURRENT CASE
610 CIA /INVERT IT
611 TAD (140+100) /ADD SUM OF POSSIBLE VALUES
612 DCA SCRCASE /STORE NEW INVERTED CASE
613 JMP I SCRPRNT /RETURN
614 \fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE
615 SPA /ARE WE INITIALIZING?
616 JMP PUTINITIALIZE /YES
617 AND (177) /JUST IN CASE
618 DCA LATEST /SAVE LATEST CHARACTER
619 TAD LATEST /GET LATEST CHARACTER
620 JMP I PUTNEXT /GO WHERE YOU SHOULD GO
621
622 PUTNEXT,.-. /EXIT ROUTINE
623 ISZ PUTBYTE /BUMP TO GOOD RETURN
624 PUTERRO,CLA CLL /CLEAN UP
625 JMP I PUTBYTE /RETURN TO MAIN CALLER
626
627 PUTINIT,CLA /CLEAN UP
628 TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
629 DCA PUTRECORD /STORE IN-LINE
630 DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
631 PUTNEWR,TAD (OUTBUFFER) /SETUP THE
632 DCA BUFPTR /BUFFER POINTER
633 PUTLOOP,JMS PUTNEXT /GET A CHARACTER
634 DCA I BUFPTR /STORE IT
635 TAD BUFPTR /GET POINTER VALUE
636 DCA TEMPTR /SAVE FOR LATER
637 ISZ BUFPTR /BUMP TO NEXT
638 JMS PUTNEXT /GET A CHARACTER
639 DCA I BUFPTR /STORE IT
640 JMS PUTNEXT /GET A CHARACTER
641 RTL;RTL /MOVE UP
642 AND [7400] /ISOLATE HIGH NYBBLE
643 TAD I TEMPTR /ADD ON FIRST BYTE
644 DCA I TEMPTR /STORE COMPOSITE
645 TAD LATEST /GET LATEST CHARACTER
646 RTR;RTR;RAR /MOVE UP AND
647 AND [7400] /ISOLATE LOW NYBBLE
648 TAD I BUFPTR /ADD ON SECOND BYTE
649 DCA I BUFPTR /STORE COMPOSITE
650 ISZ BUFPTR /BUMP TO NEXT
651 TAD BUFPTR /GET LATEST POINTER VALUE
652 TAD (-2^200-OUTBUFFERR) /COMPARE TO LIMIT
653 SZA CLA /SKIP IF AT END
654 JMP PUTLOOP /KEEP GOING
655 ISZ DANGCNT /TOO MANY RECORDS?
656 SKP /SKIP IF NOT
657 JMP I (SIZERR) /JUMP IF SO
658 JMS I OUTPUT /CALL I/O HANDLER
659 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
660 OUTBUFFER /BUFFER ADDRESS
661 PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
662 JMP PUTERROR /OUTPUT ERROR!
663 ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
664 ISZ PUTRECORD /BUMP TO NEXT RECORD
665 JMP PUTNEWRECORD /KEEP GOING
666 \fDOBYTE, .-. /OUTPUT A BYTE ROUTINE
667 JMS PUTBYTE /OUTPUT PASSED VALUE
668 JMP I (ENCERROR) /COULDN'T DO IT
669 JMP I DOBYTE /RETURN
670
671 PAGE
672 \f/ INPUT FILE ROUTINE.
673
674 GEIFILE,.-. /GET INPUT FILE ROUTINE
675 JMS LUKUP /TRY TO LOOKUP THE FILE
676 SKP /SKIP IF IT WORKED
677 JMP TRYNULL /TRY NULL EXTENSION VERSION
678 NULLOK, TAD LARG2 /GET NEGATED LENGTH
679 DCA INLEN /STASH IT
680 TAD LARG1 /GET FIRST INPUT RECORD
681 DCA INRECORD /STASH IT
682 JMP I GEIFILE /RETURN
683
684 / COMES HERE IF LOOKUP FAILED.
685
686 TRYNULL,CDF TBLFLD /GOTO TABLE FIELD
687 TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION
688 CDF PRGFLD /BACK TO OUR FIELD
689 SZA CLA /SKIP IF IT WAS NULL ORIGINALLY
690 JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
691 DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
692 JMS LUKUP /TRY TO LOOK IT UP AGAIN
693 JMP NULLOK /THAT WORKED!
694 JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE
695
696 LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE
697 TAD (IFNAME) /GET OUR FILENAME POINTER
698 DCA LARG1 /STORE IN-LINE
699 DCA LARG2 /CLEAR SECOND ARGUMENT
700 TAD IDNUMBER /GET INPUT DEVICE NUMBER
701 CIF USRFLD /GOTO USR FIELD
702 JMS I [USR] /CALL USR ROUTINE
703 LOOKUP /WANT LOOKUP FUNCTION
704 LARG1, .-. /WILL BE POINTER TO OUR FILENAME
705 LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY)
706 ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS
707 JMP I LUKUP /RETURN EITHER WAY
708 \f/ INPUT FILENAME PRINT ROUTINE.
709
710 PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE
711 TAD IMSW /GET IMAGE-MODE SWITCH
712 SNA CLA /SKIP IF SET
713 JMP DOIFNAME /JUMP IF NOT
714 JMS I [SCRIBE] /OUTPUT THE
715 IFMSG /IMAGE MESSAGE
716 CDF TBLFLD /GOTO TABLE FIELD
717 TAD I [EQUWRD] /GET EQUALS PARAMETER
718 CDF PRGFLD /BACK TO OUR FIELD
719 JMS I (OCTOUT) /OUTPUT IT
720 CDF TBLFLD /GOTO TABLE FIELD
721 TAD I [SWY9] /GET /Y-/9 SWITCHES
722 CDF PRGFLD /BACK TO OUR FIELD
723 AND [600] /JUST /1, /2 BITS
724 SNA /SKIP IF SOMETHING SET
725 JMP I PIFNAME /JUST RETURN IF NOT
726 AND [400] /JUST /1 BIT
727 SNA CLA /SKIP IF /1 SET
728 JMP PIFPT2 /JUMP IF /2 SET
729 JMS I [SCRIBE] /OUTPUT THE
730 PT1MSG /PART ONE MESSAGE
731 JMP I PIFNAME /RETURN
732
733 PIFPT2, JMS I [SCRIBE] /OUTPUT THE
734 PT2MSG /PART TWO MESSAGE
735 JMP I PIFNAME /RETURN
736
737 DOIFNAM,TAD IFNAME /GET FIRST PAIR
738 JMS PIF2 /PRINT IT
739 TAD IFNAME+1 /GET SECOND PAIR
740 JMS PIF2 /PRINT IT
741 TAD IFNAME+2 /GET THIRD PAIR
742 JMS PIF2 /PRINT IT
743 TAD (".&177) /GET SEPARATOR
744 JMS PIFOUT /PRINT IT
745 TAD IFNAME+3 /GET FOURTH PAIR
746 JMS PIF2 /PRINT IT
747 JMP I PIFNAME /RETURN
748
749 PIF2, .-. /PRINT A PAIR ROUTINE
750 DCA SCRCHAR /SAVE PASSED PAIR
751 TAD SCRCHAR /GET IT BACK
752 RTR;RTR;RTR /MOVE DOWN
753 JMS PIFOUT /PRINT HIGH-ORDER FIRST
754 TAD SCRCHAR /GET IT AGAIN
755 JMS PIFOUT /PRINT LOW-ORDER
756 JMP I PIF2 /RETURN
757 \fPIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE
758 AND [77] /JUST SIXBIT
759 SNA /SKIP IF SOMETHING THERE
760 JMP I PIFOUT /ELSE IGNORE IT
761 TAD [40] /INVERT IT
762 AND [77] /REMOVE EXCESS
763 TAD [40] /INVERT IT AGAIN
764 JMS I [DOBYTE] /OUTPUT IT
765 JMP I PIFOUT /RETURN
766
767 MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE
768 TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
769 JMS CHKNAME /CHECK IF LEGAL
770 DCA FNAME /STASH IT
771 TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD
772 JMS CHKNAME /CHECK IF LEGAL
773 DCA FNAME+1 /STASH IT
774 TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD
775 JMS CHKNAME /CHECK IF LEGAL
776 DCA FNAME+2 /STASH IT
777 TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD
778 JMS CHKNAME /CHECK IF LEGAL
779 DCA FNAME+3 /STASH IT
780 JMP I MOFNAME /RETURN
781
782 / OUTPUT NAME CHECK ROUTINE.
783
784 CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE
785 DCA LUKUP /SAVE PASSED VALUE
786 TAD LUKUP /GET IT BACK
787 RTR;RTR;RTR /MOVE DOWN
788 JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK
789 JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK
790 JMP I CHKNAME /RETURN
791
792 CHKIT, .-. /ONE CHARACTER CHECK ROUTINE
793 AND [77] /JUST SIX BITS
794 TAD (-"?!200) /COMPARE TO "?"
795 SZA /SKIP IF ALREADY BAD
796 TAD (-"*+"?) /ELSE COMPARE TO "*"
797 SNA CLA /SKIP IF NEITHER BAD CASE
798 JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER
799 TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME
800 JMP I CHKIT /RETURN
801 \f PAGE
802 \fCALCHKS,.-. /CALCULATE CHECKSUM ROUTINE
803 TAD CHKFLG /SHOULD WE CHECKSUM?
804 SZA CLA /SKIP IF SO
805 JMP I CALCHKSUM /JUMP IF NOT
806 JMS CHKSETUP /SETUP
807 TAD PUTEMP /GET PASSED VALUE
808 CLL RAR /CLEAR LINK AND MOVE OVER
809 ADDLUP, RAL /MOVE OVER CARRY
810 TAD I XR1 /ADD A WORD
811 DCA I XR2 /STORE BACK
812 ISZ CCNT /DONE ENOUGH?
813 JMP ADDLUP /NO, KEEP GOING
814 JMP I CALCHKSUM /YES, RETURN
815
816 CHKOUT, .-. /OUTPUT THE CHECKSUM ROUTINE
817 JMS CHKSETUP /SETUP
818 ISZ CHKFLG /DISABLE CHECKSUMMING
819 TAD I XR1 /GET A WORD
820 JMS I [PUTIT] /OUTPUT IT
821 ISZ CCNT /DONE YET?
822 JMP .-3 /NO, KEEP GOING
823 JMP I CHKOUT /YES, WE'RE DONE
824
825 CLRCHKS,.-. /CLEAR CHECKSUM ROUTINE
826 JMS CHKSETUP /SETUP
827 DCA I XR1 /CLEAR A WORD
828 ISZ CCNT /DONE YET?
829 JMP .-2 /NO, DO ANOTHER
830 DCA CHKFLG /ENABLE CHECKSUMMING
831 JMP I CLRCHKSUM /RETURN
832
833 INVCHKS,.-. /CHECKSUM INVERSION ROUTINE
834 JMS CHKSETUP /SETUP
835 STL /FORCE INITIAL CARRY
836 COMLUP, TAD I XR1 /GET A WORD
837 CMA /INVERT IT
838 SZL /SKIP IF NO CARRY
839 CLL IAC /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME
840 DCA I XR2 /STORE BACK
841 ISZ CCNT /DONE ALL YET?
842 JMP COMLUP /NO, KEEP GOING
843 JMP I INVCHKSUM /YES, RETURN
844
845 CHKSETU,.-. /CHECKSUM SETUP ROUTINE
846 TAD (CHKSUM-1) /POINT TO
847 DCA XR1 /CHECKSUM AREA
848 TAD (CHKSUM-1) /POINT TO
849 DCA XR2 /CHECKSUM AREA
850 TAD [-5] /SETUP THE
851 DCA CCNT /CHECKSUM COUNT
852 JMP I CHKSETUP /RETURN
853 \f/ FILE DATE ROUTINE.
854
855 FDMESSA,.-. /PUT FILE DATE IN MESSAGE ROUTINE
856 TAD FDATE /GET INPUT FILE'S DATE
857 SNA CLA /SKIP IF ANY
858 JMP I FDMESSAGE /RETURN IF NONE
859 JMS I [SCRIBE] /PRINT OUT THE
860 DATMSG /DATE BLURB
861 TAD FDATE /GET IT BACK
862 JMS PRDATE /PRINT THE DATE
863 JMS I [SCRIBE] /PRINT THE
864 EMSG /END MESSAGE
865 JMP I FDMESSAGE /RETURN
866
867 TDMESSA,.-. /PUT TODAY'S DATE IN MESSAGE ROUTINE
868 JMS I [SCRIBE] /OUTPUT THE
869 REMMSG /OPENING REMARKS
870 CDF TBLFLD /GOTO TABLE FIELD
871 TAD I (DATWRD) /GET DATE WORD
872 CDF PRGFLD /BACK TO OUR FIELD
873 SNA /SKIP IF THERE
874 JMP NOTDATE /JUMP IF NOT
875 DCA TDATE /SAVE TODAY'S DATE
876 JMS I [SCRIBE] /OUTPUT THE
877 ONMSG /BRIDGING MESSAGE
878 TAD TDATE /GET TODAY'S DATE
879 JMS PRDATE /PRINT TODAY'S DATE
880 NOTDATE,JMS I [SCRIBE] /OUTPUT THE
881 EMSG /END MESSAGE
882 JMP I TDMESSAGE /RETURN
883 \fPRDATE, .-. /DATE PRINT ROUTINE
884 DCA PRTEMP /SAVE PASSED VALUE
885 TAD PRTEMP /GET IT BACK
886 RTR;RAR /MOVE DOWN
887 AND [37] /JUST DAY BITS
888 JMS I (DEC2) /PRINT AS TWO DIGITS
889 TAD PRTEMP /GET DATE AGAIN
890 AND [7400] /JUST MONTH BITS
891 CLL RTL;RTL;RTL /MOVE DOWN
892 TAD (MONLST-2-1) /POINT TO PROPER ELEMENT
893 DCA XR1 /STASH THE POINTER
894 TAD I XR1 /GET FIRST PAIR
895 DCA I (MMSG+1) /STORE IN MESSAGE
896 TAD I XR1 /GET SECOND PAIR
897 DCA I (MMSG+2) /STORE IN MESSAGE
898 JMS I [SCRIBE] /OUTPUT THE
899 MMSG /MONTH MESSAGE
900 TAD PRTEMP /GET DATE AGAIN
901 AND [7] /JUST YEAR BITS
902 DCA TEMP /SAVE IT
903 CDF TBLFLD /GOTO TABLE FIELD
904 TAD I (DATWRD) /GET CURRENT DATE WORD
905 CDF PRGFLD /BACK TO OUR FIELD
906 AND [7] /JUST YEAR BITS
907 CIA /INVERT FOR TEST
908 TAD TEMP /COMPARE TO DESIRED YEAR
909 SMA SZA CLA /SKIP IF THEY MATCH OR ARE EARLIER
910 TAD (-10) /ELSE BACKUP A GROUP
911 TAD TEMP /ADD TO YEAR
912 DCA TEMP /STORE BACK
913 TAD I (DATEXT) /GET EXTENSION WORD
914 AND [600] /JUST EXTENSION BITS
915 CLL RTR;RTR /MAKE IT GROUP COUNT
916 TAD TEMP /ADD ON RELATIVE YEAR
917 TAD (106) /MAKE IT ABSOLUTE YEAR (70-99)
918 JMS I (DEC2) /PRINT AS TWO DIGITS
919 JMP I PRDATE /RETURN
920
921 PAGE
922 \fDEC2, .-. /PRINT TWO DIGITS ROUTINE
923 JMS DIVIDE /DIVIDE
924 12 /BY 10
925 TAD ["0&177] /MAKE IT ASCII
926 JMS I [DOBYTE] /OUTPUT IT
927 TAD REM /GET SECOND DIGIT
928 TAD ["0&177] /MAKE IT ASCII
929 JMS I [DOBYTE] /OUTPUT IT
930 JMP I DEC2 /RETURN
931
932 / DIVIDE ROUTINE.
933
934 DIVIDE, .-. /DIVIDE ROUTINE
935 DCA REM /SAVE IN REMAINDER
936 DCA QUO /CLEAR QUOTIENT
937 TAD REM /GET IT BACK
938 STL CIA /INVERT
939 SKP /DON'T FIRST TIME
940 DVLOOP, ISZ QUO /BUMP UP QUOTIENT
941 TAD I DIVIDE /ADD ON ARGUMENT
942 SNA SZL /UNDERFLOW?
943 JMP DVLOOP /NO, KEEP GOING
944 CIA /YES, INVERT IT BACK
945 TAD I DIVIDE /RESTORE LOST VALUE
946 DCA REM /SAVE AS REMAINDER
947 TAD QUO /GET THE QUOTIENT
948 ISZ DIVIDE /BUMP PAST ARGUMENT
949 JMP I DIVIDE /RETURN
950
951 INDATE, .-. /GET INPUT FILE'S DATE WORD
952 CDF TBLFLD /GOTO TABLE FIELD
953 TAD IMSW /GET IMAGE-MODE SWITCH
954 SNA CLA /SKIP IF SET
955 JMP NOIMG /JUMP IF NOT
956 TAD I (DATWRD) /USE TODAY'S DATE
957 JMP NOAIW /CONTINUE THERE
958
959 NOIMG, TAD I (AIWCNT) /GET AIW COUNT
960 SNA /SKIP IF ANY
961 JMP NOAIW /JUMP IF NOT
962 TAD I [AIWXR] /GET ENTRY POINTER
963 DCA TEMP /STASH FIRST AIW POINTER
964 TAD I TEMP /GET FIRST AIW
965 NOAIW, DCA FDATE /SAVE AS FILE'S DATE
966 CDF PRGFLD /BACK TO OUR FIELD
967 JMP I INDATE /RETURN
968 \f/ INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
969
970 MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE
971 TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD
972 SNA /SKIP IF SOMETHING THERE
973 JMP IMTEST /JUMP IF NOT
974 IFNAMOK,DCA IFNAME /STASH IT
975 TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD
976 DCA IFNAME+1 /STASH IT
977 TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD
978 DCA IFNAME+2 /STASH IT
979 TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD
980 SNA /SKIP IF SOMETHING THERE
981 TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE
982 DCA IFNAME+3 /STASH IT EITHER WAY
983 JMP I MIFNAME /RETURN
984
985 / TEST IF IMAGE-MODE IS SET. ASSUME /1 AND /2 ARE NOT SET.
986
987 IMTEST, TAD I (SWAL) /GET /A-/L SWITCHES
988 AND (10) /JUST /I BIT
989 SZA CLA /SKIP IF NOT SET
990 TAD I [EQUWRD] /GET EQUALS PARAMETER
991 SNA /SKIP IF SOMETHING THERE
992 JMP I (INERR) /ELSE COMPLAIN
993 CIA /INVERT IT
994 DCA INLEN /USE AS INPUT RECORD COUNT
995 DCA INRECORD /START AT THE BEGINNING OF THE DEVICE
996 ISZ IMSW /INDICATE IMAGE-MODE SET
997
998 / TEST IF /1 OR /2 IS SET.
999
1000 TAD I [SWY9] /GET /Y-/9 SWITCHES
1001 AND [600] /JUST /1, /2 SWITCHES
1002 SNA /SKIP IF EITHER SET
1003 JMP IFNAMOK /JUMP IF NEITHER SET
1004
1005 / TEST IF /1 IS SET. IF NOT, /2 MUST BE SET.
1006
1007 AND [400] /JUST /1 SWITCH
1008 SNA CLA /SKIP IF /1 SET
1009 JMP IM2 /JUMP IF /2 SET
1010
1011 / FOR A FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH. THE DATA STARTS AT
1012 / RECORD ZERO (ALREADY SET).
1013
1014 TAD I [EQUWRD] /GET EQUALS PARAMETER
1015 CLL RAR /%2
1016 IM2ENTR,CIA /INVERT IT
1017 DCA INLEN /SET COUNT FOR HALF OF THE DEVICE
1018 JMP IFNAMOK /KEEP GOING
1019 \f/ FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN).
1020
1021 IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
1022 CLL RAR /%2
1023 DCA INRECORD /SETUP STARTING RECORD
1024
1025 / FOR A SECOND HALF, THE COUNT IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE
1026 / FIRST HALF.
1027
1028 TAD I [EQUWRD] /GET EQUALS PARAMETER
1029 CLL RAR /%2
1030 CIA /INVERT IT
1031 TAD I [EQUWRD] /SUBTRACT FROM EQUALS PARAMETER
1032 JMP IM2ENTRY /CONTINUE THERE
1033
1034 CHKBND, .-. /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE
1035 TAD OBOUND /GET BOUNDARY COUNTER
1036 TAD (5) /COMPARE TO BEGINNING VALUE
1037 SNA CLA /SKIP IF NOT AT BEGINNING
1038 ISZ CHKBND /SET SKIP RETURN IF AT BEGINNING
1039 JMP I CHKBND /RETURN EITHER WAY
1040
1041 OCTOUT, .-. /OCTAL OUTPUT ROUTINE
1042 DCA OCTEMP /SAVE IT
1043 TAD (-4) /SETUP THE
1044 DCA OCTCNT /DIGIT COUNTER
1045 OCTLUP, TAD OCTEMP /GET THE VALUE
1046 RTL;RAL /MOVE UP A DIGIT
1047 DCA OCTEMP /STORE BACK
1048 TAD OCTEMP /GET IT AGAIN
1049 RAL /PUT INTO CORRECT BITS
1050 AND [7] /JUST ONE DIGIT
1051 TAD ["0&177] /MAKE IT ASCII
1052 JMS I [DOBYTE] /OUTPUT IT
1053 ISZ OCTCNT /DONE ENOUGH?
1054 JMP OCTLUP /NO, GO BACK FOR MORE
1055 JMP I OCTOUT /YES, RETURN TO CALLER
1056
1057 PAGE
1058 \f/ FILE TEXT MESSAGES.
1059
1060 DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: "
1061 EMSG, TEXT ")%^"
1062 ENDMSG, TEXT ">%(^END ^"
1063 EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%"
1064 FILMSG, TEXT "(^FILE "
1065 IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^"
1066 \fMMSG, TEXT "-^D^EC-19"
1067 ONMSG, TEXT ": ^"
1068 PT1MSG, TEXT " ^F^IRST ^H^ALF"
1069 PT2MSG, TEXT " ^S^ECOND ^H^ALF^"
1070 \fREMMSG, TEXT "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^"
1071 "0+VERSION^100+".-200; "0+REVISION^100+" -200
1072 TEXT " C^HARLES ^L^ASNER)%"
1073 \f TEXT "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8"
1074
1075 / MONTH TEXT TABLE.
1076
1077 MONLST, TEXT "J^AN" /JANUARY
1078 TEXT "F^EB" /FEBRUARY
1079 TEXT "M^AR" /MARCH
1080 TEXT "A^PR" /APRIL
1081 TEXT "M^AY" /MAY
1082 TEXT "J^UN" /JUNE
1083 TEXT "J^UL" /JULY
1084 TEXT "A^UG" /AUGUST
1085 TEXT "S^EP" /SEPTEMBER
1086 TEXT "O^CT" /OCTOBER
1087 TEXT "N^OV" /NOVEMBER
1088 TEXT "D^EC" /DECEMBER
1089 \f $ /THAT'S ALL FOLK!
My complete PDP-8 universe