| 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! |