A large commit.
[pdp8.git] / sw / kermit / k12 / k12dec.pal
1 / OS/8 DECODING PROGRAM
2
3 / LAST EDIT: 08-JUL-1992 22:00:00 CJL
4
5 / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE
6 / FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS LONG AS ALL
7 / PRINTING DATA CHARACTERS ARE NOT MODIFIED.
8
9 / DISTRIBUTED BY CUCCA AS "K12DEC.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 / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY
22 / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS
23 / FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS EXTRANEOUS WHITE SPACE AND
24 / EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT,
25 / SUCH AS A TRAILING CHECKSUM.
26
27 / CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR
28 / COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES. THE (FILE ) AND
29 / (END ) COMMANDS CONTAIN THE SUGGESTED FILENAME FOR THE DESCENDANT DECODED
30 / FILE.
31 \f/ WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE
32 / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE
33 / OR A SPECIFIED DEVICE:
34
35 / .RUN DEV DECODE INVOKE PROGRAM.
36 / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT).
37 / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:.
38 / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:.
39 / *DEV:<INPUT=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED
40 / INTO RECORD 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN
41 / VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE
42 / ALL DATA RECORDS, BUT NEED NOT BE STATED EXACTLY.
43 / (THE ENCODE PROGRAM REQUIRES PRECISE STATEMENT OF THE
44 / LENGTH IN IMAGE TRANSFER ENCODING MODE. **** NOTE
45 / **** THIS METHOD VIOLATES ALL OS/8 DEVICE STRUCTURE
46 / AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE IMAGES
47 / ONLY; USE WITH CARE!
48 / *DEV:<INPUT=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
49 / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS
50 / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
51 / BECAUSE IT IS USED TO CALCULATE THE APPROX. 1/2 VALUE
52 / ACTUALLY USED IN THIS HALF OF THE OVERALL TRANSFER.
53 / THIS MODE SHOULD BE USED WITH FILES CREATED FOR THE
54 / EXPRESS PURPOSE OF TRANSMISSION BY HALVES ONLY; USE
55 / WITH CARE!
56 / *DEV:<INPUT=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR
57 / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS
58 / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY
59 / BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF
60 / THE APPROX. 1/2 VALUE ACTUALLY USED IN THIS HALF OF
61 / THE OVERALL TRANSFER. THIS MODE SHOULD BE USED WITH
62 / FILES CREATED FOR THE EXPRESS PURPOSE OF TRANSMISSION
63 / BY HALVES ONLY; USE WITH CARE! NOTE THAT THERE MUST
64 / BE TWO FILES CREATED, ONE USING /I/1 AND THE OTHER
65 / USING /I/2 TO COMPLETELY TRANSFER A DEVICE IMAGE
66 / UNLESS /I IS USED ALONE!
67 / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT).
68 / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE
69 / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT.
70 / . PROGRAM EXITS NORMALLY.
71 \f/ INPUT FILE ASSUMES .EN EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
72 / IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE
73 / OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE.
74
75 / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
76 / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
77 / CHARACTER.
78
79 / THIS PROGRAM SUPPORTS A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED
80 / BY CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING
81 / WITH COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR
82 / VERSIONS).
83
84 / RESTRICTIONS:
85
86 / A) SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE.
87
88 / B) IGNORES ALL (END ) COMMANDS.
89
90 / C) <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES; NO CHECK IS MADE FOR
91 / WHETHER THE > IS ON THE SAME LINE AS THE <.
92
93 / D) PDP-8 GENERATED CHECKSUM DATA MUST BE THE FINAL DATA IN THE FILE IN
94 / THE PROPER FORMAT: ZCCCCCCCCCCCC WHERE CCCCCCCCCCCC IS THE
95 / TWELVE-CHARACTER PDP-8 CHECKSUM DATA.
96
97 / IF THE ENCODED FILE IS PASSED THROUGH ANY INTERMEDIARY PROCESS THAT MODIFIES
98 / THE CONTENTS IN A WAY THAT INTERFERES WITH ANY OF THE ABOVE, THIS DECODING
99 / PROGRAM WILL FAIL. IT IS THE USER'S RESPONSIBILITY TO EDIT OUT UNWANTED
100 / CHANGES TO THE ENCODED FILE. ALL OTHER ASPECTS OF THE PROTOCOL ARE OBEYED,
101 / SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO EFFECT ON
102 / THE RELIABILITY OF THE DECODING PROCESS, ETC.
103 \f/ ERROR MESSAGES.
104
105 / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD
106 / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE
107 / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
108 / THE FOLLOWING USER ERRORS ARE DEFINED:
109
110 / ERROR NUMBER PROBABLE CAUSE
111
112 / 0 TOO MANY OUTPUT FILES.
113
114 / 1 NO INPUT FILE OR TOO MANY INPUT FILES.
115
116 / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR.
117
118 / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME.
119
120 / 4 ERROR WHILE FETCHING FILE HANDLER.
121
122 / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
123
124 / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
125
126 / 7 ERROR WHILE CLOSING THE OUTPUT FILE.
127
128 / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA.
129
130 / ASSEMBLY INSTRUCTIONS.
131
132 / IT IS ASSUMED THE SOURCE FILE K12DEC.PAL HAS BEEN MOVED AND RENAMED TO
133 / DSK:DECODE.PA.
134
135 / .PAL DECODE<DECODE ASSEMBLE SOURCE PROGRAM
136 / .LOAD DECODE LOAD THE BINARY FILE
137 / .SAVE DEV DECODE=0 SAVE THE CORE-IMAGE FILE
138 \f/ DEFINITIONS.
139
140 CLOSE= 4 /CLOSE OUTPUT FILE
141 DECODE= 5 /CALL COMMAND DECODER
142 ENTER= 3 /ENTER TENTATIVE FILE
143 EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD
144 FETCH= 1 /FETCH HANDLER
145 IHNDBUF=7200 /INPUT HANDLER BUFFER
146 INBUFFE=6200 /INPUT BUFFER
147 INFILE= 7617 /INPUT FILE INFORMATION HERE
148 INQUIRE=12 /INQUIRE ABOUT HANDLER
149 NL0001= CLA IAC /LOAD AC WITH 0001
150 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
151 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000
152 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
153 NL7777= CLA CMA /LOAD AC WITH 7777
154 OHNDBUF=6600 /OUTPUT HANDLER BUFFER
155 OUTBUFF=5600 /OUTPUT BUFFER
156 OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
157 PRGFLD= 00 /PROGRAM FIELD
158 RESET= 13 /RESET SYSTEM TABLES
159 SBOOT= 7600 /MONITOR EXIT
160 SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD
161 SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD
162 TBLFLD= 10 /COMMAND DECODER TABLE FIELD
163 TERMWRD=7642 /TERMINATOR WORD
164 USERROR=7 /USER SIGNALLED ERROR
165 USR= 7700 /USR ENTRY POINT
166 USRFLD= 10 /USR FIELD
167 WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71)
168 WRITE= 4000 /I/O WRITE BIT
169 \f *0 /START AT THE BEGINNING
170
171 *10 /DEFINE AUTO-INDEX AREA
172
173 XR1, .-. /AUTO-INDEX NUMBER 1
174 XR2, .-. /AUTO-INDEX NUMBER 2
175
176 *20 /GET PAST AUTO-INDEX AREA
177
178 BUFPTR, .-. /OUTPUT BUFFER POINTER
179 CCNT, .-. /CHECKSUM COUNTER
180 CHKSUM, ZBLOCK 5 /CHECKSUM TEMPORARY
181 CHRCNT, .-. /CHARACTER COUNTER
182 CSUMTMP,.-. /CHECKSUM TEMPORARY
183 DANGCNT,.-. /DANGER COUNT
184 DATCNT, .-. /DATA COUNTER
185 DSTATE, .-. /DATA STATE VARIABLE
186 IDNUMBE,.-. /INPUT DEVICE NUMBER
187 IMSW, .-. /IMAGE-MODE SWITCH
188 INITFLA,.-. /INITIALIZE INPUT FLAG
189 INPUT, .-. /INPUT HANDLER POINTER
190 INRECOR,.-. /INPUT RECORD
191 FCHKSUM,ZBLOCK 5 /FILE CHECKSUM
192 FNAME, ZBLOCK 4 /OUTPUT FILENAME
193 GWTMP1, .-. /GETWORD TEMPORARY
194 GWTMP2, .-. /GETWORD TEMPORARY
195 GWVALUE,.-. /LATEST WORD VALUE
196 ODNUMBE,.-. /OUTPUT DEVICE NUMBER
197 OUTPUT, .-. /OUTPUT HANDLER POINTER
198 OUTRECO,.-. /OUTPUT RECORD
199 PUTEMP, .-. /OUTPUT TEMPORARY
200 PUTPTR, .-. /OUTPUT POINTER
201 THIRD, .-. /THIRD BYTE TEMPORARY
202
203 / STATE TABLE.
204
205 P, SCANIT /0000 LOOKING FOR "(" OR "<"
206 FNDCOMMAND /0001 FOUND "(" AND NOW LOOKING FOR ")"
207 FNDCEND /0002 FOUND ")" AND NOW LOOKING FOR <CR>
208 FNDCR /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
209 STORDATA /4000 FOUND "<" AND PROCESSING 69 DATA BYTES
210 ENDATA /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">"
211 ENDCR /4002 FOUND ">" AND NOW LOOKING FOR <CR>
212 FNDCR/ENDLF /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET
213 \f PAGE /START AT THE USUAL PLACE
214
215 BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO
216 CLA /CLEAN UP
217 START, CIF USRFLD /GOTO USR FIELD
218 JMS I [USR] /CALL USR ROUTINE
219 DECODE /WANT COMMAND DECODER
220 "E^100+"N-300 /.EN IS DEFAULT EXTENSION
221 CDF TBLFLD /GOTO TABLE FIELD
222 TAD I (TERMWRD) /GET TERMINATOR WORD
223 SPA CLA /SKIP IF <CR> TERMINATED THE LINE
224 DCA EXITZAP /ELSE CAUSE EXIT LATER
225 DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH
226 TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD
227 SNA /SKIP IF FIRST OUTPUT FILE PRESENT
228 JMP TSTMORE /JUMP IF NOT THERE
229 AND [17] /JUST DEVICE BITS
230 ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
231 TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
232 SNA /SKIP IF THERE
233 TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
234 SZA CLA /SKIP IF BOTH NOT PRESENT
235 JMP I (OUTERR) /ELSE COMPLAIN
236 TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
237 SNA /SKIP IF PRESENT
238 JMP I (INERR) /JUMP IF NOT
239 AND [17] /JUST DEVICE BITS
240 DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
241 TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD
242 SZA CLA /SKIP IF ONLY ONE INPUT FILE
243 JMP I (INERR) /ELSE COMPLAIN
244 TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD
245 DCA INRECORD /SET IT UP
246 CDF PRGFLD /BACK TO OUR FIELD
247 CIF USRFLD /GOTO USR FIELD
248 JMS I [USR] /CALL USR ROUTINE
249 RESET /RESET SYSTEM TABLES
250 \f TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
251 DCA IHPTR /STORE IN-LINE
252 TAD IDNUMBER /GET INPUT DEVICE NUMBER
253 CIF USRFLD /GOTO USR FIELD
254 JMS I [USR] /CALL USR ROUTINE
255 FETCH /FETCH HANDLER
256 IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
257 JMP I (FERROR) /FETCH ERROR
258 TAD IHPTR /GET RETURNED ADDRESS
259 DCA INPUT /STORE AS INPUT HANDLER ADDRESS
260 JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION
261 TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
262 DCA OHPTR /STORE IN-LINE
263 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
264 CIF USRFLD /GOTO USR FIELD
265 JMS I [USR] /CALL USR ROUTINE
266 FETCH /FETCH HANDLER
267 OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
268 JMP I (FERROR) /FETCH ERROR
269 TAD OHPTR /GET RETURNED ADDRESS
270 DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
271 TAD IMSW /GET IMAGE-MODE SWITCH
272 SNA CLA /SKIP IF SET
273 JMP NOIMAGE /JUMP IF NOT
274
275 / IF /2 IS SET, THE DATA STARTS HALF-WAY INTO THE IMAGE. OTHER IMAGE MODES
276 / START AT RECORD 0000.
277
278 CDF TBLFLD /GOTO TABLE FIELD
279 TAD I [SWY9] /GET /Y-/9 SWITCHES
280 AND (200) /JUST /2 SWITCH
281 SNA CLA /SKIP IF SET
282 JMP IMAGE1 /JUMP IF /1 OR NEITHER /1, /2 SET
283 TAD I [EQUWRD] /GET EQUALS PARAMETER
284 CLL RAR /%2
285 IMAGE1, DCA OUTRECORD /STORE STARTING OUTPUT RECORD
286 CDF PRGFLD /BACK TO OUR FIELD
287 SKP /DON'T ENTER FILE NAME
288 NOIMAGE,JMS I (FENTER) /ENTER THE TENTATIVE FILE NAME
289 DCA DSTATE /SET INITIAL DATA STATE
290 JMS I (CLRCHKSUM) /CLEAR OUT CHECKSUM
291 JMS I (DECODIT) /GO DO THE ACTUAL DECODING
292 JMP I (PROCERR) /ERROR WHILE DECODING
293 TAD IMSW /GET IMAGE-MODE SWITCH
294 SZA CLA /SKIP IF CLEAR
295 JMP EXITZAP /JUMP IF SET
296 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
297 CIF USRFLD /GOTO USR FIELD
298 JMS I [USR] /CALL USR ROUTINE
299 CLOSE /CLOSE OUTPUT FILE
300 FNAME /POINTER TO FILENAME
301 OUTCNT, .-. /WILL BE ACTUAL COUNT
302 JMP I (CLSERR) /CLOSE ERROR
303 EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
304 JMP I (SBOOT) /EXIT TO MONITOR
305 \f/ COMES HERE TO TEST FOR NULL LINE.
306
307 TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD
308 SNA /SKIP IF PRESENT
309 TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD
310 SZA CLA /SKIP IF NO OUTPUT FILES
311 JMP I (OUTERR) /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT
312 TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD
313 SZA CLA /SKIP IF NO INPUT FILES
314 JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT
315 CDF PRGFLD /BACK TO OUR FIELD
316 JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
317
318 PAGE
319 \f/ ERROR WHILE PROCESSING INPUT FILE.
320
321 PROCERR,NL0002 /SET INCREMENT
322 SKP /DON'T USE NEXT
323
324 / ERROR WHILE CLOSING THE OUTPUT FILE.
325
326 CLSERR, NL0001 /SET INCREMENT
327 SKP /DON'T CLEAR IT
328
329 / OUTPUT FILE TOO LARGE ERROR.
330
331 SIZERR, CLA /CLEAN UP
332 TAD [3] /SET INCREMENT
333 SKP /DON'T USE NEXT
334
335 / ENTER ERROR.
336
337 ENTERR, NL0002 /SET INCREMENT
338 SKP /DON'T USE NEXT
339
340 / HANDLER FETCH ERROR.
341
342 FERROR, NL0001 /SET INCREMENT
343
344 / I/O ERROR WHILE PROCESSING (FILE ) COMMAND.
345
346 NIOERR, IAC /SET INCREMENT
347
348 / FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND.
349
350 CHARERR,IAC /SET INCREMENT
351
352 / INPUT FILESPEC ERROR.
353
354 INERR, IAC /SET INCREMENT
355
356 / OUTPUT FILESPEC ERROR.
357
358 OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
359 CDF PRGFLD /ENSURE OUR FIELD
360 CIF USRFLD /GOTO USR FIELD
361 JMS I [USR] /CALL USR ROUTINE
362 USERROR /USER ERROR
363 ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
364 \fDECODIT,.-. /DECODING ROUTINE
365 TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
366 DCA PUTRECORD /STORE IN-LINE
367 DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
368 NL7777 /SETUP THE
369 DCA INITFLAG /INITIALIZE FLAG
370 TAD (GWLOOP) /INITIALIZE THE
371 DCA I (GWNEXT) /DECODE PACK ROUTINE
372 PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE
373 DCA PUTPTR /OUTPUT BUFFER POINTER
374 PUTLOOP,JMS I (GETWORD) /GET A WORD
375 DCA I PUTPTR /STORE IT
376 ISZ PUTPTR /BUMP TO NEXT
377 TAD PUTPTR /GET THE POINTER
378 TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT
379 SZA CLA /SKIP IF AT END
380 JMP PUTLOOP /KEEP GOING
381 ISZ DANGCNT /TOO MANY RECORDS?
382 SKP /SKIP IF NOT
383 JMP I (SIZERROR) /NOT ENOUGH SPACE AVAILABLE
384 JMS I OUTPUT /CALL OUTPUT HANDLER
385 2^100+WRITE /WRITE LATEST RECORD
386 POUTBUF,OUTBUFFER /OUTPUT BUFFER ADDRESS
387 PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
388 DECERR, JMP I DECODIT /I/O ERROR
389 ISZ PUTRECORD /BUMP TO NEXT RECORD
390 NOP /JUST IN CASE
391 ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
392 JMP PUTNEWRECORD /GO DO ANOTHER ONE
393
394 / GOOD RETURN HERE.
395
396 DECBMP, ISZ DECODIT /BUMP TO GOOD RETURN
397 JMP I DECODIT /RETURN
398 \f/ OS/8 FILE UNPACK ROUTINE.
399
400 GETBYTE,.-. /GET A BYTE ROUTINE
401 SNA CLA /INITIALIZING?
402 JMP I PUTC /NO, GO GET NEXT BYTE
403 TAD INRECORD /GET STARTING RECORD OF INPUT FILE
404 DCA GETRECORD /STORE IN-LINE
405 GETNEWR,JMS I INPUT /CALL I/O HANDLER
406 2^100 /READ TWO PAGES INTO BUFFER
407 INBUFFER /BUFFER ADDRESS
408 GETRECO,.-. /WILL BE LATEST RECORD NUMBER
409 JMP I GETBYTE /INPUT ERROR!
410 TAD (INBUFFER) /SETUP THE
411 DCA BUFPTR /BUFFER POINTER
412 GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
413 JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
414 JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
415 TAD THIRD /GET THIRD BYTE
416 JMS PUTC /SEND IT BACK
417 TAD BUFPTR /GET THE POINTER
418 TAD (-2^200-INBUFFER) /COMPARE TO LIMIT
419 SZA CLA /SKIP IF AT END
420 JMP GETLOOP /KEEP GOING
421 ISZ GETRECORD /BUMP TO NEXT RECORD
422 JMP GETNEWRECORD /GO DO ANOTHER ONE
423
424 PUTONE, .-. /SEND BACK A BYTE ROUTINE
425 TAD I BUFPTR /GET LATEST WORD
426 AND (7400) /JUST THIRD-BYTE NYBBLE
427 CLL RAL /MOVE UP
428 TAD THIRD /GET OLD NYBBLE (IF ANY)
429 RTL;RTL /MOVE UP NYBBLE BITS
430 DCA THIRD /SAVE FOR NEXT TIME
431 TAD I BUFPTR /GET LATEST WORD AGAIN
432 JMS PUTC /SEND BACK CURRENT BYTE
433 ISZ BUFPTR /BUMP TO NEXT WORD
434 JMP I PUTONE /RETURN
435
436 PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
437 AND (177) /KEEP ONLY GOOD BITS
438 TAD (-"Z!300) /COMPARE TO <^Z>
439 SNA /SKIP IF NOT ASCII <EOF>
440 JMP GETEOF /JUMP IF ASCII MODE <EOF>
441 TAD ("Z&37) /RESTORE THE CHARACTER
442 ISZ GETBYTE /BUMP PAST <EOF> RETURN
443 GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN
444 JMP I GETBYTE /RETURN TO MAIN CALLER
445 \f PAGE
446 \f/ GET A DECODED WORD ROUTINE.
447
448 GETWORD,.-. /GET A WORD ROUTINE
449 JMP I GWNEXT /GO WHERE YOU SHOULD GO
450
451 GWNEXT, .-. /EXIT ROUTINE
452 SNL /SKIP IF CHECKSUM PREVENTED
453 JMS I (DOCHECK) /ELSE DO CHECKSUM
454 JMP I GETWORD /RETURN TO MAIN CALLER
455
456 / COMES HERE TO PROCESSED COMPRESSED DATA.
457
458 GWX, JMS I (GETCHR) /GET NEXT CHARACTER
459 JMS I (GWORD0) /GET 12-BIT WORD
460 JMS I (DOCHECK) /INCLUDE IN CHECKSUM
461 DCA GWVALUE /SAVE AS COMPRESSED VALUE
462 TAD GWTMP2 /GET LATEST CHARACTER
463 AND [7] /ISOLATE BITS[9-11]
464 CLL RTR;RTR /BITS[9-11] => AC[0-2]
465 DCA GWTMP1 /SAVE FOR NOW
466 JMS GBIHEXBINARY /GET A CHARACTER
467 CLL RTL;RTL /BITS[7-11] => AC[3-7]
468 TAD GWTMP1 /ADD ON BITS[0-2]
469 JMS I (DOCHECK) /INCLUDE IN CHECKSUM
470 CLL RTR;RTR /BITS[0-7] => AC[4-11]
471 SNA /SKIP IF NOT 256
472 TAD [400] /000 => 256
473 CIA /INVERT FOR COUNTING
474 DCA GWTMP1 /SAVE AS REPEAT COUNTER
475 GWXLUP, TAD GWVALUE /GET THE VALUE
476 STL /PREVENT CHECKSUMMING IT
477 JMS GWNEXT /RETURN IT TO THEM
478 ISZ GWTMP1 /DONE ENOUGH?
479 JMP GWXLUP /NO, KEEP GOING
480 \f/ COMES HERE TO INITIATE ANOTHER DATA GROUP.
481
482 GWLOOP, JMS I (GETCHR) /GET LATEST FILE CHARACTER
483 TAD (-"Z!200) /COMPARE TO EOF INDICATOR
484 SNA /SKIP IF OTHER
485 JMP GWZ /JUMP IF IT MATCHES
486 TAD (-"X+"Z) /COMPARE TO COMPRESSION INDICATOR
487 SNA CLA /SKIP IF OTHER
488 JMP GWX /JUMP IF IT MATCHES
489 TAD PUTEMP /GET THE CHARACTER BACK
490 JMS I (GWORD0) /GET A 12-BIT WORD
491 JMS GWNEXT /RETURN IT
492 JMS I (GWORD1) /GET NEXT 12-BIT WORD
493 JMS GWNEXT /RETURN IT
494 JMS I (GWORD2) /GET NEXT 12-BIT WORD
495 JMS GWNEXT /RETURN IT
496 JMS I (GWORD3) /GET NEXT 12-BIT WORD
497 JMS GWNEXT /RETURN IT
498 JMS I (GWORD4) /GET NEXT 12-BIT WORD
499 JMS GWNEXT /RETURN IT
500 JMP GWLOOP /KEEP GOING
501
502 / COMES HERE WHEN EOF INDICATOR FOUND.
503
504 GWZ, TAD (FCHKSUM-1) /SETUP THE
505 DCA XR1 /CHECKSUM POINTER
506 JMS I (GETCHR) /GET NEXT CHARACTER
507 JMS I (GWORD0) /GET A 12-BIT WORD
508 DCA I XR1 /STORE IT
509 JMS I (GWORD1) /GET NEXT WORD
510 DCA I XR1 /STORE IT
511 JMS I (GWORD2) /GET NEXT WORD
512 DCA I XR1 /STORE IT
513 JMS I (GWORD3) /GET NEXT WORD
514 DCA I XR1 /STORE IT
515 JMS I (GWORD4) /GET NEXT WORD
516 DCA I XR1 /STORE IT
517 TAD (CHKSUM-1) /POINT TO
518 DCA XR1 /CALCULATED CHECKSUM
519 TAD (FCHKSUM-1) /POINT TO
520 DCA XR2 /FILE CHECKSUM
521 TAD [-5] /SETUP THE
522 DCA CCNT /COMPARE COUNT
523 CLL /CLEAR LINK FOR TEST
524 GWCMPLP,RAL /GET CARRY
525 TAD I XR1 /GET A CALCULATED WORD
526 TAD I XR2 /COMPARE TO FILE WORD
527 SZA CLA /SKIP IF OK
528 JMP I (DECERR) /ELSE COMPLAIN
529 ISZ CCNT /DONE ALL?
530 JMP GWCMPLP /NO, KEEP GOING
531 \f/ THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE.
532
533 TAD PUTPTR /GET OUTPUT POINTER
534 TAD (-OUTBUFFER-4) /COMPARE TO LIMIT
535 SMA SZA CLA /SKIP IF GOOD VALUE
536 JMP I (DECERROR) /JUMP IF NOT
537
538 / THE FILE ENDED OK, THERE WERE POSSIBLY A FEW CHARACTERS LEFTOVER BECAUSE OF
539 / ALIGNMENT CONSIDERATIONS. THEY SHOULD BE IGNORED SINCE OS/8 FILES ARE
540 / MULTIPLES OF WHOLE RECORDS.
541
542 JMP I (DECBMP) /RETURN WITH ALL OK
543
544 GBIHEXB,.-. /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER
545 CLA /CLEAN UP
546 TAD GBIHEXBINARY /GET OUR CALLER
547 DCA BIHEXBINARY /MAKE IT THEIRS
548 JMS I (GETCHR) /GET A CHARACTER
549 SKP /DON'T EXECUTE HEADER!
550
551 BIHEXBI,.-. /CONVERT BIHEXADECIMAL TO BINARY
552 TAD (-"A!200) /COMPARE TO ALPHABETIC LIMIT
553 SMA /SKIP IF LESS
554 TAD ("9+1-"A) /ELSE ADD ON ALPHABETIC OFFSET
555 TAD (-"0+"A) /MAKE IT BINARY, NOT ASCII
556 DCA GWTMP2 /SAVE IT
557 TAD GWTMP2 /GET IT BACK
558 JMP I BIHEXBINARY /RETURN
559
560 PAGE
561 \f/ GET WORD[0] ROUTINE. AC MUST ALREADY CONTAIN THE FIRST BI-HEXADECIMAL
562 / CHARACTER.
563
564 GWORD0, .-. /GET 12-BIT WORD[0]
565 JMS I (BIHEXBINARY) /CONVERT PASSED VALUE TO BINARY
566 CLL RTR;RTR;RTR /BITS[7-11] => AC[0-4]
567 DCA GWTMP1 /SAVE FOR NOW
568 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
569 CLL RTL /BITS[7-11] => AC[5-9]
570 TAD GWTMP1 /ADD ON BITS[0-4]
571 DCA GWTMP1 /SAVE FOR NOW
572 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
573 RTR;RAR /BITS[7-8] => AC[10-11]
574 AND [3] /ISOLATE BITS[10-11]
575 TAD GWTMP1 /ADD ON BITS[0-9]
576 CLL /CLEAR LINK
577 JMP I GWORD0 /RETURN
578
579 / GET WORD[1] ROUTINE. GWORD0 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
580 / THE PREVIOUS CHARACTER.
581
582 GWORD1, .-. /GET 12-BIT WORD[1]
583 TAD GWTMP2 /GET PREVIOUS CHARACTER
584 AND [7] /ISOLATE BITS[9-11]
585 CLL RTR;RTR /BITS[9-11] => AC[0-2]
586 DCA GWTMP1 /SAVE FOR NOW
587 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
588 CLL RTL;RTL /BITS[7-11] => AC[3-7]
589 TAD GWTMP1 /ADD ON BITS[0-2]
590 DCA GWTMP1 /SAVE FOR NOW
591 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
592 CLL RAR /BITS[7-10] => AC[8-11]
593 TAD GWTMP1 /ADD ON BITS[0-7]
594 CLL /CLEAR LINK
595 JMP I GWORD1 /RETURN
596 \f/ GET WORD[2] ROUTINE. GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
597 / THE PREVIOUS CHARACTER.
598
599 GWORD2, .-. /GET 12-BIT WORD[2]
600 TAD GWTMP2 /GET PREVIOUS CHARACTER
601 RAR;CLA RAR /BIT[11] => AC[0]
602 DCA GWTMP1 /SAVE FOR NOW
603 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
604 CLL RTL;RTL;RTL /BITS[7-11] => AC[1-5]
605 TAD GWTMP1 /ADD ON BIT[0]
606 DCA GWTMP1 /SAVE FOR NOW
607 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
608 CLL RAL /BITS[7-11] => AC[6-10]
609 TAD GWTMP1 /ADD ON BITS[0-5]
610 DCA GWTMP1 /SAVE FOR NOW
611 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
612 AND (20) /ISOLATE BIT[7]
613 CLL RTR;RTR /BIT[7] => AC[11]
614 TAD GWTMP1 /ADD ON BITS[0-10]
615 CLL /CLEAR LINK
616 JMP I GWORD2 /RETURN
617
618 / GET WORD[3] ROUTINE. GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
619 / THE PREVIOUS CHARACTER.
620
621 GWORD3, .-. /GET 12-BIT WORD[3]
622 TAD GWTMP2 /GET PREVIOUS CHARACTER
623 CLL RTR;RTR;RAR /BITS[8-11] => AC[0-3]
624 DCA GWTMP1 /SAVE FOR NOW
625 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
626 CLL RTL;RAL /BITS[7-11] => AC[4-8]
627 TAD GWTMP1 /ADD ON BITS[0-3]
628 DCA GWTMP1 /SAVE FOR NOW
629 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
630 RTR /BITS[7-9] => AC[9-11]
631 AND [7] /ISOLATE BITS[9-11]
632 TAD GWTMP1 /ADD ON BITS[0-8]
633 CLL /CLEAR LINK
634 JMP I GWORD3 /RETURN
635 \f/ GET WORD[4] ROUTINE. GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS
636 / THE PREVIOUS CHARACTER.
637
638 GWORD4, .-. /GET 12-BIT WORD[4]
639 TAD GWTMP2 /GET PREVIOUS CHARACTER
640 AND [3] /ISOLATE BITS[10-11]
641 CLL RTR;RAR /BITS[10-11] => AC[0-1]
642 DCA GWTMP1 /SAVE FOR NOW
643 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
644 CLL RTL;RTL;RAL /BITS[7-11] => AC[2-6]
645 TAD GWTMP1 /ADD ON BITS[0-1]
646 DCA GWTMP1 /SAVE FOR NOW
647 JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY
648 TAD GWTMP1 /ADD ON BITS[0-6] TO BITS[7-11]
649 CLL /CLEAR LINK
650 JMP I GWORD4 /RETURN
651
652 DOCHECK,.-. /CHECKSUM ROUTINE
653 DCA CSUMTMP /SAVE PASSED VALUE
654 TAD (CHKSUM-1) /SETUP THE
655 DCA XR1 /INPUT POINTER
656 TAD (CHKSUM-1) /SETUP THE
657 DCA XR2 /OUTPUT POINTER
658 TAD [-5] /SETUP THE
659 DCA CCNT /SUM COUNT
660 TAD CSUMTMP /GET THE VALUE
661 CLL RAR /ADJUST FOR OPENING ITERATION
662 CSUMLUP,RAL /GET CARRY
663 TAD I XR1 /ADD ON A WORD
664 DCA I XR2 /STORE BACK
665 ISZ CCNT /DONE ALL YET?
666 JMP CSUMLUP /NO, KEEP GOING
667 TAD CSUMTMP /GET LATEST VALUE
668 JMP I DOCHECK /RETURN
669
670 PAGE
671 \fGETCHR, .-. /GET A VALID CHARACTER ROUTINE
672 GETMORE,TAD INITFLAG /GET INITIALIZE FLAG
673 JMS I [GETBYTE] /GET A CHARACTER
674 JMP I (DECERR) /I/O ERROR
675 JMP I (DECERR) /<EOF>
676 DCA PUTEMP /SAVE THE CHARACTER
677 DCA INITFLAG /CLEAR INITIALIZE FLAG
678 TAD DSTATE /GET DATA STATE
679 SPA /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES
680 TAD (4004) /ADD ON DATA-ORIENTED STATES OFFSET
681 TAD (JMP I P) /SETUP JUMP INSTRUCTION
682 DCA .+1 /STORE IN-LINE
683 .-. /AND EXECUTE IT
684
685 / LOOKING FOR OPENING CHARACTER.
686
687 SCANIT, TAD PUTEMP /GET THE CHARACTER
688 TAD (-"<!200) /COMPARE TO OPENING DATA CHARACTER
689 SNA /SKIP IF NO MATCH
690 JMP FNDATA /JUMP IF IT MATCHES
691 TAD (-"(+"<) /COMPARE TO OPENING COMMAND CHARACTER
692 SNA CLA /SKIP IF NO MATCH
693 ISZ DSTATE /INDICATE LOOKING FOR END OF COMMAND
694 JMP GETMORE /KEEP GOING
695
696 / FOUND OPENING COMMAND CHARACTER.
697
698 FNDCOMM,TAD PUTEMP /GET THE CHARACTER
699 TAD (-")!200) /COMPARE TO CLOSING COMMAND CHARACTER
700 SNA CLA /SKIP IF NO MATCH
701 ISZ DSTATE /INDICATE LOOKING FOR <CR>
702 JMP GETMORE /KEEP GOING
703
704 / FOUND CLOSING COMMAND CHARACTER.
705
706 FNDCEND,TAD PUTEMP /GET THE CHARACTER
707 TAD (-"M!300) /COMPARE TO <CR>
708 SNA CLA /SKIP IF NO MATCH
709 ISZ DSTATE /INDICATE LOOKING FOR <LF>
710 JMP GETMORE /KEEP GOING
711
712 / FOUND <CR> AFTER COMMAND.
713
714 FNDCR, TAD PUTEMP /GET THE CHARACTER
715 TAD (-"J!300) /COMPARE TO <LF>
716 SNA CLA /SKIP IF NO MATCH
717 DCA DSTATE /RESET TO SCANNING STATE
718 JMP GETMORE /KEEP GOING
719 \f/ FOUND OPENING DATA CHARACTER.
720
721 FNDATA, TAD (-WIDTH) /SETUP THE
722 DCA DATCNT /DATA COUNTER
723 NL4000 /SETUP THE
724 DCA DSTATE /NEW STATE
725 JMP GETMORE /KEEP GOING
726
727 / PROCESSING ONE OF 69 DATA CHARACTERS.
728
729 STORDAT,TAD PUTEMP /GET THE CHARACTER
730 TAD [-140] /SUBTRACT UPPER-CASE LIMIT
731 SPA /SKIP IF LOWER-CASE
732 TAD [40] /RESTORE UPPER-CASE
733 TAD (100) /RESTORE THE CHARACTER
734 DCA PUTEMP /SAVE IT BACK
735 TAD PUTEMP /GET IT AGAIN
736 TAD (-"Z!200-1) /SUBTRACT UPPER LIMIT
737 CLL /CLEAR LINK FOR TEST
738 TAD ("Z-"A+1) /ADD ON RANGE
739 SZL CLA /SKIP IF NOT ALPHABETIC
740 JMP ALPHAOK /JUMP IF ALPHABETIC
741 TAD PUTEMP /GET THE CHARACTER
742 TAD (-"9!200-1) /ADD ON UPPER LIMIT
743 CLL /CLEAR LINK FOR TEST
744 TAD ("9-"0+1) /ADD ON RANGE
745 SNL CLA /SKIP IF OK
746 JMP GETMORE /IGNORE IF NOT
747 ALPHAOK,TAD PUTEMP /GET THE CHARACTER
748 ISZ DATCNT /DONE 69 CHARACTERS?
749 SKP /SKIP IF NOT
750 ISZ DSTATE /ADVANCE TO NEXT STATE
751 JMP I GETCHR /RETURN
752
753 / PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER.
754
755 ENDATA, TAD PUTEMP /GET THE CHARACTER
756 TAD (-">!200) /COMPARE TO ENDING DATA VALUE
757 SNA CLA /SKIP IF NO MATCH
758 ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
759 JMP GETMORE /KEEP GOING
760
761 / FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>.
762
763 ENDCR, TAD PUTEMP /GET THE CHARACTER
764 TAD (-"M!300) /COMPARE TO <CR>
765 SNA CLA /SKIP IF NO MATCH
766 ISZ DSTATE /ELSE ADVANCE TO NEXT STATE
767 JMP GETMORE /KEEP GOING
768 \f/ FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>.
769
770 /ENDLF, TAD PUTEMP /GET THE CHARACTER
771 / TAD (-"J!300) /COMPARE TO <LF>
772 / SNA CLA /SKIP IF NO MATCH
773 / DCA DSTATE /RESET TO SCANNING STATE
774 / JMP GETMORE /KEEP GOING
775
776 CLRCHKS,.-. /CLEAR CALCULATED CHECKSUM ROUTINE
777 DCA CHKSUM+0 /CLEAR LOW-ORDER
778 DCA CHKSUM+1 /CLEAR NEXT
779 DCA CHKSUM+2 /CLEAR NEXT
780 DCA CHKSUM+3 /CLEAR NEXT
781 DCA CHKSUM+4 /CLEAR HIGH-ORDER
782 JMP I CLRCHKSUM /RETURN
783
784 PAGE
785 \fGEOFILE,.-. /GET OUTPUT FILE ROUTINE
786 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
787 SZA CLA /SKIP IF NOT ESTABLISHED YET
788 JMP GOTOD /JUMP IF DETERMINED ALREADY
789 TAD ("D^100+"S-300) /GET BEGINNING OF "DSK"
790 DCA DEVNAME /STORE IN-LINE
791 TAD ("K^100) /GET REST OF "DSK"
792 DCA DEVNAME+1 /STORE IN-LINE
793 DCA RETVAL /CLEAR HANDLER ENTRY WORD
794 CDF PRGFLD /INDICATE OUR FIELD
795 CIF USRFLD /GOTO USR FIELD
796 JMS I [USR] /CALL USR ROUTINE
797 INQUIRE /INQUIRE ABOUT HANDLER
798 DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK
799 RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD
800 HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE!
801 TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK:
802 AND [17] /JUST DEVICE BITS
803 DCA ODNUMBER /STORE OUTPUT DEVICE
804 GOTOD, CDF TBLFLD /BACK TO TABLE FIELD
805 TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD
806 SNA /SKIP IF PRESENT
807 JMP GFLNAME /JUMP IF NOT
808 DCA FNAME /MOVE TO OUR AREA
809 TAD I (OUTFILE+2) /GET SECOND NAME WORD
810 DCA FNAME+1 /MOVE IT
811 TAD I (OUTFILE+3) /GET THIRD NAME WORD
812 DCA FNAME+2 /MOVE IT
813 TAD I (OUTFILE+4) /GET EXTENSION WORD
814 DCA FNAME+3 /MOVE IT
815 GEOFXIT,CDF PRGFLD /BACK TO OUR FIELD
816 JMP I GEOFILE /RETURN
817
818 / WE MUST TAKE THE FILENAME FROM THE IMBEDDED (FILE ) COMMAND. THE ONLY
819 / EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER.
820
821 GFLNAME,TAD I (SWAL) /GET /A-/L SWITCHES
822 AND (10) /JUST /I BIT
823 SZA CLA /SKIP IF NOT SET
824 TAD I [EQUWRD] /GET EQUALS PARAMETER
825 SNA /SKIP IF SET TO SOMETHING
826 JMP DOFLNAME /JUMP IF PARAMETERS NOT SET
827 CMA /INVERT IT
828 DCA DANGCNT /STORE AS DANGER COUNT
829 ISZ IMSW /SET IMAGE-MODE SWITCH
830 TAD I [SWY9] /GET /Y-/9 SWITCHES
831 AND (600) /JUST /1, /2 SWITCHES
832 SNA /SKIP IF EITHER SET
833 JMP GEOFXIT /JUMP IF NEITHER SET
834 AND [400] /JUST /1 SWITCH
835 SNA CLA /SKIP IF /1 SET
836 JMP IM2 /JUMP IF /2 SET
837 TAD I [EQUWRD] /GET EQUALS PARAMETER
838 CLL RAR /%2
839 JMP IMCOMMON /CONTINUE THERE
840 \fIM2, TAD I [EQUWRD] /GET EQUALS PARAMETER
841 CLL RAR /%2
842 CIA /SUBTRACT PART 1 VALUE
843 TAD I [EQUWRD] /FROM EQUALS PARAMETER
844 IMCOMMO,CMA /INVERT IT
845 DCA DANGCNT /STORE AS DANGER COUNT
846 JMP GEOFXIT /EXIT THERE
847
848 DOFLNAM,CDF PRGFLD /BACK TO OUR FIELD
849 NL7777 /SETUP THE
850 DCA INITFLAG /INPUT FILE INITIALIZATION
851 JMS I (SCNFILE) /SCAN OFF "(FILE"
852
853 / HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME.
854
855 / ZERO OUT THE FILENAME AREA.
856
857 TAD (-10) /SETUP THE
858 DCA CHRCNT /CLEAR COUNTER
859 TAD (ONAME-1) /SETUP THE
860 DCA XR1 /POINTER
861 JMS I (CLRNAME) /CLEAR THE NAME BUFFER
862
863 / SETUP FOR SCANNING THE NAME PORTION.
864
865 TAD (-6) /SETUP THE
866 DCA CHRCNT /SCAN COUNT
867 TAD (ONAME-1) /SETUP THE
868 DCA XR1 /POINTER
869 FNCAGN, JMS I (GETAN) /GET A CHARACTER
870 JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
871 DCA I XR1 /STASH THE CHARACTER
872 ISZ CHRCNT /DONE ALL YET?
873 JMP FNCAGN /NO, KEEP GOING
874
875 / THROW AWAY EXTRA NAME CHARACTERS.
876
877 TOSSNAM,JMS I (GETAN) /GET A CHARACTER
878 JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD
879 JMP TOSSNAME /KEEP GOING
880
881 / COMES HERE AFTER "." FOUND.
882
883 GOTSEPA,JMS I (CLRNAME) /CLEAR OUT THE REMAINING NAME FIELD
884 NL7776 /SETUP THE
885 DCA CHRCNT /SCAN COUNT
886 EXCAGN, JMS I (GETAN) /GET A CHARACTER
887 JMP I [CHARERROR] /GOT "."; COMPLAIN
888 DCA I XR1 /STASH THE CHARACTER
889 ISZ CHRCNT /DONE ENOUGH YET?
890 JMP EXCAGN /NO, KEEP GOING
891 \f/ TOSS ANY EXTRA EXTENSION CHARACTERS.
892
893 TOSSEXT,JMS I (GETAN) /GET A CHARACTER
894 JMP I [CHARERROR] /GOT "."; COMPLAIN
895 JMP TOSSEXTENSION /KEEP GOING
896
897 / COMES HERE WHEN TRAILING ")" IS FOUND.
898
899 GOTRPAR,JMS I (CLRNAME) /CLEAR ANY REMAINING EXTENSION CHARACTERS
900 TAD I (ONAME) /GET THE FIRST CHARACTER
901 SNA CLA /SKIP IF SOMETHING THERE
902 JMP I [CHARERROR] /COMPLAIN IF NONE THERE
903 TAD (ONAME-1) /SETUP POINTER
904 DCA XR1 /TO NAME CHARACTERS
905 TAD (FNAME-1) /SETUP POINTER
906 DCA XR2 /TO PACKED NAME AREA
907 TAD (-4) /SETUP THE
908 DCA CHRCNT /MOVE COUNT
909 CHRLOOP,TAD I XR1 /GET FIRST CHARACTER
910 CLL RTL;RTL;RTL /MOVE UP
911 TAD I XR1 /ADD ON SECOND CHARACTER
912 DCA I XR2 /STORE THE PAIR
913 ISZ CHRCNT /DONE YET?
914 JMP CHRLOOP /NO, KEEP GOING
915 JMP I GEOFILE /YES, RETURN
916
917 PAGE
918 \fSCNFILE,.-. /SCAN "(FILE" ROUTINE
919 MATAGN, JMS GETNSPC /GET A CHARACTER
920 TAD (-"(!200) /COMPARE TO "("
921 SZA CLA /SKIP IF IT MATCHES
922 JMP MATAGN /JUMP IF NOT
923 JMS GETNSPC /GET NEXT CHARACTER
924 TAD (-"F!300) /COMPARE TO "F"
925 SZA CLA /SKIP IF IT MATCHES
926 JMP MATAGN /JUMP IF NOT
927 JMS GETNSPC /GET NEXT CHARACTER
928 TAD (-"I!300) /COMPARE TO "I"
929 SZA CLA /SKIP IF IT MATCHES
930 JMP MATAGN /JUMP IF NOT
931 JMS GETNSPC /GET NEXT CHARACTER
932 TAD (-"L!300) /COMPARE TO "L"
933 SZA CLA /SKIP IF IT MATCHES
934 JMP MATAGN /JUMP IF NOT
935 JMS GETNSPC /GET NEXT CHARACTER
936 TAD (-"E!300) /COMPARE TO "E"
937 SZA CLA /SKIP IF IT MATCHES
938 JMP MATAGN /JUMP IF NOT
939 JMP I SCNFILE /RETURN
940
941 CLRNAME,.-. /NAME FIELD CLEARING ROUTINE
942 TAD CHRCNT /GET CHARACTER COUNTER
943 SNA CLA /SKIP IF ANY TO CLEAR
944 JMP I CLRNAME /ELSE JUST RETURN
945 DCA I XR1 /CLEAR A NAME WORD
946 ISZ CHRCNT /COUNT IT
947 JMP .-2 /KEEP GOING
948 JMP I CLRNAME /RETURN
949
950 GETNSPC,.-. /GET NON-<SPACE> CHARACTER
951 GETNAGN,JMS GETCHAR /GET A CHARACTER
952 TAD (-" !200) /COMPARE TO <SPACE>
953 SNA CLA /SKIP IF OTHER
954 JMP GETNAGN /JUMP IF IT MATCHES
955 TAD PUTEMP /GET THE CHARACTER BACK
956 JMP I GETNSPC /RETURN
957
958 GETCHAR,.-. /GET A CHARACTER ROUTINE
959 CLA /CLEAN UP
960 TAD INITFLAG /GET INITIALIZE FLAG
961 JMS I [GETBYTE] /GET A CHARACTER
962 JMP I (NIOERROR) /COMPLAIN IF AN ERROR
963 JMP I [CHARERROR] /COMPLAIN IF <EOF> REACHED
964 TAD [-140] /COMPARE TO LOWER-CASE LIMIT
965 SPA /SKIP IF LOWER-CASE
966 TAD [40] /RESTORE ORIGINAL IF UPPER-CASE
967 AND (77) /JUST SIX-BIT
968 DCA PUTEMP /SAVE IN CASE WE NEED IT
969 DCA INITFLAG /CLEAR INITIALIZE FLAG
970 TAD PUTEMP /GET IT BACK
971 JMP I GETCHAR /RETURN
972 \fGETAN, .-. /GET ALPHANUMERIC ROUTINE
973 JMS GETNSPC /GET A NON-<SPACE> CHARACTER
974 TAD (-".!200) /COMPARE TO "."
975 SNA /SKIP IF OTHER
976 JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES
977 TAD (-")+".) /COMPARE TO ")"
978 SNA /SKIP IF OTHER
979 JMP I (GOTRPAREN) /TAKE DEDICATED RETURN IF IT MATCHES
980 TAD (-":+")) /SUBTRACT UPPER LIMIT
981 CLL /CLEAR LINK FOR TEST
982 TAD (":-"0) /ADD ON RANGE
983 SZL CLA /SKIP IF NOT NUMERIC
984 JMP GETANOK /JUMP IF NUMERIC
985 TAD PUTEMP /GET THE CHARACTER BACK
986 TAD (-"[!300) /SUBTRACT UPPER LIMIT
987 CLL /CLEAR LINK FOR TEST
988 TAD ("[-"A) /ADD ON RANGE
989 SNL CLA /SKIP IF ALPHABETIC
990 JMP I [CHARERROR] /ELSE COMPLAIN
991 GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER
992 ISZ GETAN /BUMP TO SKIP RETURN
993 JMP I GETAN /RETURN
994
995 ONAME, ZBLOCK 10 /OUTPUT NAME FIELD
996
997 FENTER, .-. /FILE ENTER ROUTINE
998 TAD (FNAME) /POINT TO
999 DCA ENTAR1 /STORED FILENAME
1000 DCA ENTAR2 /CLEAR SECOND ARGUMENT
1001 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
1002 CIF USRFLD /GOTO USR FIELD
1003 JMS I [USR] /CALL USR ROUTINE
1004 ENTER /ENTER TENTATIVE FILENAME
1005 ENTAR1, .-. /WILL POINT TO FILENAME
1006 ENTAR2, .-. /WILL BE ZERO
1007 JMP I (ENTERR) /ENTER ERROR
1008 TAD ENTAR2 /GET RETURNED EMPTY LENGTH
1009 IAC /ADD 2-1 FOR OS/278 CRAZINESS
1010 DCA DANGCNT /STORE AS DANGER COUNT
1011 TAD ENTAR1 /GET RETURNED FIRST RECORD
1012 DCA OUTRECORD /SETUP OUTPUT RECORD
1013 JMP I FENTER /RETURN
1014 \f PAGE
1015
1016 $ /THAT'S ALL FOLK!