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