projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / kermit / hachti / K12ENC.PA
CommitLineData
81e70d48
PH		 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
160XR1, .-. /AUTO-INDEX NUMBER 1
161XR2, .-. /AUTO-INDEX NUMBER 2
162
163 *20 /GET PAST AUTO-INDEX AREA
164
165BUFPTR, .-. /OUTPUT BUFFER POINTER
166CCNT, .-. /CHECKSUM COUNTER
167CHKFLG, .-. /CHECKSUMMING ALLOWED FLAG
168CHKSUM, ZBLOCK 5 /CHECKSUM
169CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
170DANGCNT,.-. /DANGER COUNT
171FDATE, .-. /FILE DATE
172FILLVAL,.-. /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS
173IDNUMBE,.-. /INPUT DEVICE NUMBER
174IFNAME, ZBLOCK 4 /INPUT FILENAME
175IMSW, .-. /IMAGE-MODE SWITCH
176INLEN, .-. /INPUT FILE LENGTH
177INPTR, .-. /INPUT BUFFER POINTER
178INPUT, .-. /INPUT HANDLER POINTER
179INRECOR,.-. /INPUT RECORD
180FNAME, ZBLOCK 4 /OUTPUT FILENAME
181LATEST, .-. /LATEST OUTPUT CHARACTER
182OBOUND, .-. /OUTPUT BOUNDARY COUNTER
183OCTCNT, .-. /OCTAL OUTPUT ROUTINE COUNTER
184OCTEMP, .-. /OCTAL OUTPUT ROUTINE TEMPORARY
185ODNUMBE,.-. /OUTPUT DEVICE NUMBER
186OUTPUT, .-. /OUTPUT HANDLER POINTER
187OUTRECO,.-. /OUTPUT RECORD
188PRTEMP, .-. /DATE OUTPUT TEMPORARY
189PUTEMP, .-. /OUTPUT TEMPORARY
190PUTLATE,.-. /LATEST 5-BIT CHARACTER
191PUTPREV,.-. /PREVIOUS OUTPUT TEMPORARY
192QUO, .-. /DIVIDE QUOTIENT
193REM, .-. /DIVIDE REMAINDER
194SCRCASE,.-. /CURRENT MESSAGE CASE
195SCRCHAR,.-. /LATEST MESSAGE CHARACTER
196SCRPTR, .-. /MESSAGE POINTER
197TDATE, .-. /TODAY'S DATE
198TEMP, .-. /TEMPORARY
199TEMPTR, .-. /TEMPORARY OUTPUT POINTER
200WIDCNT, .-. /LINE WIDTH COUNTER
201\f PAGE /START AT THE USUAL PLACE
202
203BEGIN, NOP /IN CASE WE'RE CHAINED TO
204 CLA /CLEAN UP
205START, 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
245OHPTR, .-. /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
255IHPTR, .-. /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
270ENTAR1, .-. /WILL POINT TO FILENAME
271ENTAR2, .-. /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
286OUTCNT, .-. /WILL BE ACTUAL COUNT
287 JMP CLSERR /CLOSE ERROR
288EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
289 JMP I (SBOOT) /EXIT TO MONITOR
290\f/ ERROR WHILE PROCESSING INPUT FILE.
291
292PROCERR,NL0002 /SET INCREMENT
293 SKP /DON'T USE NEXT
294
295/ ERROR WHILE CLOSING THE OUTPUT FILE.
296
297CLSERR, NL0001 /SET INCREMENT
298 SKP /DON'T CLEAR IT
299
300/ OUTPUT FILE TOO LARGE ERROR.
301
302SIZERR, CLA /CLEAN UP
303 TAD [3] /SET INCREMENT
304 SKP /DON'T USE NEXT
305
306/ ENTER ERROR.
307
308ENTERR, NL0002 /SET INCREMENT
309 SKP /DON'T USE NEXT
310
311/ HANDLER FETCH ERROR.
312
313FERROR, NL0001 /SET INCREMENT
314
315/ NO OUTPUT FILENAME ERROR.
316
317NONAMER,IAC /SET INCREMENT
318
319/ ILLEGAL OUTPUT FILE NAME ERROR.
320
321BADNAME,IAC /SET INCREMENT
322
323/ INPUT FILESPEC ERROR.
324
325INERR, IAC /SET INCREMENT
326
327/ OUTPUT FILESPEC ERROR.
328
329OUTERR, 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
334ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
335
336/ COMES HERE TO TEST FOR NULL LINE.
337
338TSTMORE,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
361ENCLOOP,JMS I INPUT /CALL INPUT HANDLER
362 2^100 /READ TWO PAGES
363PINBUFF,INBUFFER /INTO INPUT BUFFER
364INREC, .-. /WILL BE LATEST INPUT FILE RECORD
365ENCERRO,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
370LOOP, 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
375CMPLUP, 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
388CMPEND, 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
410NOCOMPR,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
417TEST, 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
426ENDLUP, 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>
446CLOSLUP,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
460PUTNXT, 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
465PUTLUP, JMS PUTNXT /GET ANOTHER WORD
466PUT0, 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
473PUT1, 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
486PUT2, 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
509PUT4, 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
525CHKNL, .-. /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
532OUTSETU,.-. /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
545PUTNORM,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
570SCRIBE, .-. /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
576SCRLUP, 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
584SCRPRNT,.-. /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
601SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER
602 JMP I SCRPRNT /RETURN
603
604SCRCRLF,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
609SCRFLIP,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
622PUTNEXT,.-. /EXIT ROUTINE
623 ISZ PUTBYTE /BUMP TO GOOD RETURN
624PUTERRO,CLA CLL /CLEAN UP
625 JMP I PUTBYTE /RETURN TO MAIN CALLER
626
627PUTINIT,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
631PUTNEWR,TAD (OUTBUFFER) /SETUP THE
632 DCA BUFPTR /BUFFER POINTER
633PUTLOOP,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
661PUTRECO,.-. /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
674GEIFILE,.-. /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
678NULLOK, 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
686TRYNULL,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
696LUKUP, .-. /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
704LARG1, .-. /WILL BE POINTER TO OUR FILENAME
705LARG2, .-. /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
710PIFNAME,.-. /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
733PIFPT2, JMS I [SCRIBE] /OUTPUT THE
734 PT2MSG /PART TWO MESSAGE
735 JMP I PIFNAME /RETURN
736
737DOIFNAM,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
749PIF2, .-. /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
767MOFNAME,.-. /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
784CHKNAME,.-. /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
792CHKIT, .-. /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
809ADDLUP, 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
816CHKOUT, .-. /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
825CLRCHKS,.-. /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
833INVCHKS,.-. /CHECKSUM INVERSION ROUTINE
834 JMS CHKSETUP /SETUP
835 STL /FORCE INITIAL CARRY
836COMLUP, 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
845CHKSETU,.-. /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
855FDMESSA,.-. /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
867TDMESSA,.-. /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
880NOTDATE,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
934DIVIDE, .-. /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
940DVLOOP, 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
951INDATE, .-. /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
959NOIMG, 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
965NOAIW, 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
970MIFNAME,.-. /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
974IFNAMOK,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
987IMTEST, 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
1016IM2ENTR,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
1021IM2, 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
1034CHKBND, .-. /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
1041OCTOUT, .-. /OCTAL OUTPUT ROUTINE
1042 DCA OCTEMP /SAVE IT
1043 TAD (-4) /SETUP THE
1044 DCA OCTCNT /DIGIT COUNTER
1045OCTLUP, 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
1060DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: "
1061EMSG, TEXT ")%^"
1062ENDMSG, TEXT ">%(^END ^"
1063EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%"
1064FILMSG, TEXT "(^FILE "
1065IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^"
1066\fMMSG, TEXT "-^D^EC-19"
1067ONMSG, TEXT ": ^"
1068PT1MSG, TEXT " ^F^IRST ^H^ALF"
1069PT2MSG, 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
1077MONLST, 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