/P?S-LAP6W CONVERSION PROGRAM /PROGRAM OPTIONS / EQUALS PARAMETER IS LAP6W RECORD (NOT BLOCK) TO READ/WRITE / FROM/TO ON LOGICAL UNIT 7 (UNIT 7 IS DEFAULT) / /0-/7 USE PASSED SWITCH AS UNIT NUMBER / DEFAULT IS P?S UNIT 7 / DEFINITIONS FROM P?S MONITOR SYSTEM SYSIO= 7640 /SYSTEM I/O ENTRY POINT WRITE= 4000 /SYSIO WRITE BIT *0 /START AT BEGINNING BAD, CLA /MAY BE DIRTY TAD L7 /^G TLS /RING THE BELL STA /SET UP MQL /MQ LIGHTS STA /IN CASE NO EAE USE STA NOT MQA HLT /STOP STUPID L7600, 7600 /GET RID OF SOME LIGHTS JMP I L7600 /BOOT STRAP BUFCNT, -2400 /BUFFER COUNT COUNT, 2000 /WORD COUNT FLAG, -3 /TRIPLE WORD FLAG PUSHCT, -7 /SHIFT COUNT RESET, -2400 /RESET VALUE FOR WORD COUNT XRIN, 0 /INDEX IN XROUT, 0 /INDEX OUT BUFFER= 0200 /BUFFER POINTER BUFPTR, BUFFER /BUFFER POINTER LCTLZ, 32 /CONSTANT 0032 MCTLZ, -232 /CONSTANT 7546 L100, 100 /CONSTANT 0100 L12, 12 /CONSTANT 0012 L13, 13 /CONSTANT 0013 L14, 14 /CONSTANT 0014 L15, 15 /CONSTANT 0015 L17, 17 /CONSTANT 0017 L177, 177 /CONSTANT 0177 L20, 20 /CONSTANT 0020 L200, 200 /CONSTANT 0200 L21, 21 /CONSTANT 0021 L360, 360 /CONSTANT 0360 L37, 37 /CONSTANT 0037 L40, 40 /CONSTANT 0040 L46, 46 /CONSTANT 0046 L5, 5 /CONSTANT 0005 L6776, 6776 /CONSTANT 6776 L6777, 6777 /CONSTANT 6777 L7, 7 /CONSTANT 0007 L7400, 7400 /CONSTANT 7400 L7601, 7601 /CONSTANT 7601 L7605, 7605 /CONSTANT 7605 L7640, 7640 /CONSTANT 7640 L7652, 7652 /CONSTANT 7652 L7653, 7653 /CONSTANT 7653 L77, 77 /CONSTANT 0077 L7741, 7741 /CONSTANT 7741 L7770, 7770 /CONSTANT 7770 L7775, 7775 /CONSTANT 7775 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 PGCH, GCH /POINTER TO GCH ROUTINE PTR, 4600 /INPUT POINTER P6CH, XP6CH /POINTER TO 6-BIT PRINT ROUTINE TEMP, 0 /TEMPORARY TEMP2, 0 /TEMPORARY WORD, 0 /WORD TEMPORARY OUTPS8, JMS I PGCH /GRAB A CHAR JMS PUTCHR /PUT A CHAR ISZ CORE /SKIPPED AS NECESSARY ISZ COUNT /BUFFER DONE? JMP OUTPS8 /NO, GO BACK NL2000 /RESET DCA COUNT /BUFFER COUNT CLOSE, TAD L377 /RESET DCA CORE /CORE POINTER JMS I PSYSIO /\ CORE, 377 / \WRITE OUT 6000 WFUN, 20^100+WRITE / /PS/8 CHARS BLOCK, 16 // TAD BLOCK /\ TAD L20 / >UPDATE BLOCK NUMBER DCA BLOCK // CLZAP, JMP OUTPS8 /GO BACK,JACK,AND DO IT AGAIN JMP I L7600 /BOOTSTRAP PUTCHR, 0 /PUT 1 CHARACTER DCA I CORE /PUT INTO BUFFER ISZ FLAG /OK? JMP CHKCL2 /YES .... NL7775 /NO,RESET DCA FLAG /FLAG NL7776 /\ TAD CORE / >POINT TO FIRST FIXUP DCA TEMP // TAD I CORE /\ AND L360 / \ CLL RTL / \ RTL / >FIX UP FIRST WORD TAD I TEMP / / DCA I TEMP / / ISZ TEMP // TAD I CORE /\ AND L17 / \ CLL RAR / \ RTR / >FIX UP SECOND WORD RTR / / TAD I TEMP / / DCA I TEMP // ISZ PUTCHR /BUMP RETURN CHKCL2, TAD I CORE /\ TAD MCTLZ / \CHECK FOR PSYSIO, SZA CLA / /CONTROL Z JMP I PUTCHR // TAD CORE /\ IAC / \ AND L7400 / \CREATE CORRECT STL RAR / /# OF BLOCKS TAD PRMUNT / / DCA WFUN // DCA CLZAP /DESTROY LOOP JMP CLOSE /FINISH UP FILPTR, 7757 /FILE POINTER L377, 377 /CONSTANT 0377 PRMUNT, 7 /LAP6W UNIT;DEFAULT IS 7 PAGE NOPUNCH *7000 /WHERE THIS EXECUTES ENPUNCH /LAP6W CHARACTER FETCH ROUTINE NEWBUF, TAD L7400 /MAKE IT READ DCA I L7601 /THEIR BLOCKS JMS I L7640 /CALL I/O ROUTINES INCORE, BUFFER /TO INFUN, 12^100 /READ IN LAPBLK, .-. /FILE;FILLED IN BY = PARM TAD L7600 /RESET DCA I L7601 /I/O ROUTINES GETUM, TAD I BUFPTR /GET A PAIR CLL RTR /GET HIGH ORDER RTR /HALF TO THE RTR /LOW ORDER JMS GETC /EXIT TAD I BUFPTR /GET IT AGAIN JMS GETC /EXIT ISZ BUFPTR /BUMP TO NEXT PAIR ISZ BUFCNT /DONE ALL YET ? JMP GETUM /NO, DO ANOTHER TAD LAPBLK /\ TAD L5 / >UPDATE BLOCK # DCA LAPBLK // TAD RESET /RESET THE DCA BUFCNT /BUFFER COUNT TAD INCORE /RESET THE DCA BUFPTR /BUFFER POINTER JMP NEWBUF /GO DO NEXT GETC, 0 /EXIT ROUTINE AND L77 /JUST 6-BIT TAD TABADR /ADD ON TABLE BASE DCA TEMP /SAVE IT TAD I TEMP /GET PERTINENT ADDRESS SMA /ADDRESS ? JMP EOLINE /NO, A VALUE DCA TEMP2 /SAVE IT JMP I TEMP2 /GO THERE LETTER, TAD TEMP /GET ORIGINAL ADDRESS TAD FIXIT1 /RESTORE TO ASCII EOLINE, JMS I P6CH /PUT OUT THE CHARACTER JMP I GETC /RETURN TO NEXT NUMBER, TAD FIXIT2 /CORRECT THE OFFSET JMP LETTER /KEEP GOING EOMS, STA /INDICATE CLOSE JMS I LPQWRITE /CLOSE THE FILE JMP I L7600 /BOOTSTRAP,WE'RE DONE BADDY, JMP BAD /BARF ON BAD CHARACTERS FIXIT1, -TABLE-24+1 /FIXUP FOR LETTERS FIXIT2, "0&77+24-1 /FIXUP FOR NUMBERS TABADR, TABLE /CHARACTER TABLE FOR LAP6W CHARACTERS LPQWRIT,PQWRITE /POINTER TO P?S OUTPUT ROUTINES /LAP6W INPUT TRANSLATE TABLE TABLE= . /TRANSLATE TABLE STARTS HERE / 0 0 1 2 3 4 5 6 7 0 / 0 1 2 3 4 5 6 7 / 00 01 02 03 04 05 06 07 NUMBER; NUMBER; NUMBER; NUMBER; NUMBER; NUMBER; NUMBER; NUMBER / 1 0 1 2 3 4 5 6 7 1 / 8 9 ; * - / 10 11 12 13 14 15 16 17 NUMBER; NUMBER; EOLINE; BADDY; " &77; ";&77; "*&77; "-&77 / 2 0 1 2 3 4 5 6 7 2 / + / # ^ A B C D / 20 21 22 23 24 25 26 27 "+&77; "/&77; "#&77; "^&77; LETTER; LETTER; LETTER; LETTER / 3 0 1 2 3 4 5 6 7 3 / E F G H I J K L / 30 31 32 33 34 35 36 37 LETTER; LETTER; LETTER; LETTER; LETTER; LETTER; LETTER; LETTER / 4 0 1 2 3 4 5 6 7 4 / M N O P Q R S T / 40 41 42 43 44 45 46 47 LETTER; LETTER; LETTER; LETTER; LETTER; LETTER; LETTER; LETTER / 5 0 1 2 3 4 5 6 7 5 / U V W X Y Z % / 50 51 52 53 54 55 56 57 LETTER; LETTER; LETTER; LETTER; LETTER; LETTER;"\&77; "%&77 / 6 0 1 2 3 4 5 6 7 6 / ? = ! , . $ [ ] / 60 61 62 63 64 65 66 67 "?&77; "=&77; "!&77; ",&77; ".&77; "$&77; "[&77; "]&77 / 7 0 1 2 3 4 5 6 7 7 / " ' < > ( ) : / 70 71 72 73 74 75 76 77 ""&77; "'&77; "<&77; ">&77; "(&77; ")&77; ":&77; EOMS / 0 0 1 2 3 4 5 6 7 0 ZBLOCK .+177&7600-. /GET TO NEXT PAGE /P?S MONITOR FILE CREATOR /ENTRY POINT FOR INITIALIZE ROUTINE PQINIT, 0 /PARAMETER INITIALIZER PQ7770, SPA SNA SZL CLA /THIS DEFINITELY CLEARS AC PQ7, 7 /THIS MIGHT BE HARMLESSLY SKIPPED TAD I PQINIT /GET FIRST ARG AND PQ7770 /JUST FILE BITS DCA PQFILE /SAVE AS FILE PTR TAD I PQINIT /GET FILE ARG AGAIN AND PQ7 /JUST UNIT BITS TAD PQ6000 /20 BLOCKS DCA PQFUN /PUT INTO CALL ISZ PQINIT /BUMP TO NEXT ARG TAD I PQINIT /GET NEXT ARG ISZ PQINIT /BUMP PAST DCA PQNUM /SAVE AS STARTING LINE NUMBER TAD I PQINIT /GET NEXT ARG ISZ PQINIT /BUMP PAST ARGUMENT DCA PQINC /SAVE AS LINE NUMBER INCREMENT TAD PQBUFF /GET BUFFER POINTER DCA PQPTR /RESET TAD PQLFT1 /RESET DCA PQPUT /CO-ROUTINE TAD PQ6777 /FIZZY CONSTANT DCA PQWORK /TO PLACE HOLDER JMS PQLINE /FINISH EMPTY LINE JMP I PQINIT /RETURN /ENTRY POINT FOR PQS FILE CREATOR PQWRITE,0 /WRITE A FILE SPA /EOF ? JMP PQCLOSE /YES,DUMP FILE AND PQ77 /JUST TO MAKE SURE SNA /SKIP IF NON-C.R. JMP PQEOL /PUT IN LINE ON C.R. JMS PQSTORE /PUSH IT IN PQSRET, ISZ PQWRITE /BUMP TO BEYOND ARGS JMP I PQWRITE /RETURN TO SENDER PQEOL, JMS PQSTORE /PUT A ZERO IN ISZ PQPTR /BUMP TO NEXT PAIR DCA I PQPTR /CLOSE FILE IN CASE LAST TAD PQLFT1 /RESET DCA PQPUT /CO-ROUTINE TAD PQNUM /GET LINE NUMBER ENTRY DCA I PQWORK /STORE IN NUMBER WORD TAD PQNUM /GET LINE NUMBER TAD PQINC /UPDATE DCA PQNUM /PUT BACK JMS PQLINE /GO FINISH LINE TAD I PQ6776 /CHECK FOR FULL TAD PQPROT /PROTECTION VALUE CIA /SUBTRACT TAD I PQ6777 /FROM SECOND POINTER PQCLOSE,SMA CLA /OK ? JMP PQSRET /YES JMS I PQSYS /\ PQBUFF, 3000 / \WRITE OUT PQFUN, 20^100+WRITE / /1 FILE PQFILE, 40 // JMS PQINIT /\ 40 / \INITIALIZE FOR PQPROT, 310 / /NEXT TIME 12 // JMP I PQWRITE /RETURN TO CALLER PQLINE, 0 /LINE FINISHING ROUTINE NL7775 /BACKUP 3 TAD PQWORK /ADD ON CURRENT POINTER DCA PQWORK /SAVE IT BACK TAD PQWORK /GET IT AGAIN DCA I PQ6777 /SAVE AS LINE INFO POINTER TAD PQPTR /GET CURRENT BUFFER POINTER DCA I PQ6776 /SAVE AS FILE POINTER TAD PQPTR /GET AGAIN DCA I PQWORK /SAVE IN DUMMY PAIR ISZ PQWORK /BUMP TO DUMMY LINE STA /-1 IS DUMMY LINE VALUE DCA I PQWORK /SAVE DUMMY LINE NUMBER JMP I PQLINE /RETURN PQSTORE,0 /STORE ROUTINE JMP I PQPUT /GO WHEREVER PQPUT, PQLEFT+1 /EXIT ROUTINE DCA I PQPTR /STORE PAIR JMP I PQSTORE /RETURN TO MAIN PQLEFT, ISZ PQPTR /BUMP TO NEXT PAIR STL RTL /SHIFT LEFT STL RTL /WITH SOME STL RTL /NICE BITS JMS PQPUT /STORE IT DCA PQINIT /SAVE PASSED CHARACTER TAD I PQPTR /GET PREVIOUS CHARACTER AND PQCLOSE /JUST BITS 0-5 TAD PQINIT /ADD ON LATEST CHARACTER JMS PQPUT /STORE BACK JMP PQLEFT /KEEP GOING PQINC, 12 /10 DEC. A GOOD VALUE PQNUM, 144 /100 DEC ALSO GOOD PQPTR, 3000 /FILE BUFFER POINTER PQWORK, 0 /REAR FILE POINTER PQSYS, SYSIO /POINTER TO SYSIO ENTRY PQ6000, 6000 /CONSTANT 6000 PQ6776, 6776 /CONSTANT 6776 PQ6777, 6777 /CONSTANT 6777 PQ77, 77 /CONSTANT 0077 PQLFT1, PQLEFT+1 /ADDRESS CONSTANT /END OF P?S FILE CREATOR XP6CH, NEWBUF /SIX-BIT OUTPUT ROUTINE JMS PQWRITE /PUT A CHAR SKP /SKIP IF IT CLOSED JMP I XP6CH /RETURN IF OK ISZ FILPTR /\ INLAP6, TAD I FILPTR / \GET NEXT FILE SNA / /BARF IF NONE JMP BAD // DCA INBLK2 /SAVE FILE IN LINE JMS PQINIT /\ INBLK2, 0 / \INITIALIZE 144 / /NEXT FILE 12 // JMP I XP6CH /RETURN ENDPCH= . /END OF ROUTINES TO BE MOVED ZBLOCK .+177&7600-. /EMPTY SPACE NOPUNCH *200 /WHERE IT GOES LATER ENPUNCH IFNZRO .-200 < /COMPLAIN ABOUT BOTCHED ASSEMBLY **** ERROR **** UNABLE TO ASSEMBLE / $ > GCH, 0 /GET A CHAR ROUTINE JMP I TRIM /GO WHERE YOU'RE SUPPOSED TO GETBAK, TAD I PTR /GET NEXT PAIR SNA /EOF ? JMP EOF /YES CLL RTR /\ RTR / \NO,TRIM RTR / /AND EXIT JMS TRIM // TAD I PTR /GET SECOND CHAR JMS TRIM /TRIM AND EXIT ISZ PTR /BUMP TO NEXT PAIR TAD PTR /\ TAD L200 / >CHECK IF BUFFER EMPTY SZA CLA // JMP GETBAK /NO,CONTINUE GRABBING CHAR'S EOB, JMS I PSYSIO /\ L4400, 4400 / \READ IN EFUN, 15^100 / /NEW BUFFER EBLOCK, 40 // TAD L15 /\ TAD EBLOCK / >UPDATE BLOCK # DCA EBLOCK // TAD L4400 /RESET DCA PTR /BUFFER POINTER JMP GETBAK /NOW GRAB SOME CHAR'S TRIM, EOF+1 /TRIM TO 6-BIT ROUTINE AND L77 /JUST LOW-ORDER SIX SNA /SKI IF NOT C. R. JMP EOL /JUMP IF C. R. TAD L7741 /TAB ? SNA /SKIP IF NO TAD L7652 /CONVRT TO 11 CODE SPA /ALPHA ? TAD L100 /YES TAD L37 /RESTORE CHAR JMP GEXIT /AND EXIT EOL, TAD ER1 /MAKE IT GET A DCA TRIM /LINE-FEED NEXT TIME TAD L15 /GIVE IT JMP GEXIT /A C. R. THIS TIME ER1, .+1 /WHERE TO COME NEXT FOR LINEFEED TAD ER2 /MAKE IT ALWAYS BE ALIGNED DCA TRIM /AROUND POTENTIAL GARBAGE CHAR TAD L12 /GIVE IT A LINEFEED JMP GEXIT /PUT IN SHIFT REGISTER ER2, EOB-5 /<- TO ALIGNED RETURN EOF, ISZ FILPTR /BUMP TO NEXT FILE TAD L7770 /GET FILE MASK AND I FILPTR /AND AGAINST FILE BITS SNA /EOLIST ? JMP EOT /YES DCA EBLOCK /SAVE BLOCK # TAD L7 /GET UNIT MASK AND I FILPTR /AND AGAINST FILE BITS TAD E1500 /ADD ON READ OF 15 BLOCKS DCA EFUN /SAVE IN LINE JMP EOB /GO READ A BUFFER IN EOT, STA /RESET FILE PTR TAD FILPTR /SO IT GIVES DCA FILPTR /US AN EOT AGAIN TAD LCTLZ /GIVE AN ^Z GEXIT, DCA I PT1 /JMP XIT2 IF /K CLL /CLEAR LINK FOR CALL JMS SHIFT /SHIFT LATEST CHARACTER IN TAD PT1 /POINT XR TO DCA XRIN /TEST STRING JMS SETUP /SETUP REST OF PARAMETERS TESTLP, TAD I XRIN /\ CIA / \ TAD I XROUT / >CHECK FOR MAGIC SEQUENCE SZA CLA / / JMP XIT // ISZ PUSHCT /DONE ALL YET ? JMP TESTLP /NO,GO BACK STL /FOUND IT SO PURGE THE STACK JMS SHIFT /INSTEAD OF PLAIN SHIFT TAD L14 /GIVE A F. F. JMP XIT2 /AND EXIT XIT, TAD I CPTR /NULL CHAR ? SNA /SKIP IF NO JMP I TRIM /YES,THROW IT AWAY XIT2, TAD L200 /ADD ON MARK STATE JMP I GCH /RETURN SETUP, 0 /SETUP ROUTINE TAD L7770 /RESET DCA PUSHCT /COUNT STA CML /FLIP LINK SO IT FLIPS BACK TAD CPTR /SETUP PTR DCA XROUT /IN OUTPUT XR JMP I SETUP /RETURN SHIFT, 0 /SHIFTING ROUTINE TAD CPTR /SETUP DCA XRIN /INPUT XR JMS SETUP /SETUP COUNT AND OUTPUT XR SNL /IF LINK ON THEN CLEAR TAD I XRIN /IF LINK OFF THEN SHIFT DCA I XROUT /DO SOMETHING TO 1 ELEMENT ISZ PUSHCT /DONE YET ? JMP .-4 /NO,GO BACK JMP I SHIFT /YES,RETURN E1500, 1500 /READ CONSTANT PT1, T1 /POINTER TO END OF STACK CPTR, OUTCHR /POINTER TO BEGINNING OF STACK OUTCHR, ZBLOCK 10 /STACK T1, 0 /A PTR TO THIS WILL POINT TO TEST STRING ALSO 11 / "E&177 /E "J&177 /J "E&177 /E "C&177 /C "T&177 /T 15 / 12 / ENDGCH= . /END OF GET CHAR ROUTINE *1000 DSTART, TAD I FILPTR /GET FIRST FILE SNA CLA /SKIP IF AT LEAST UNO FILE JMP BAD /NO FILES, BARF TAD I L7756 /GET = PARM CMA /TEST FOR NONE SZA /SKIP IF NOT PASSED CMA /RE-INVERT DCA BLOCK /PUT IN BLOCK ARG TAD I L7606 /GET SWITCHS /Y-/9 RAL /DO INITIAL ADJUST CHKLUP, RAL /GET NEXT SWITCH SPA /IS IT ON ? JMP CHKEND /YES ISZ CHKCNT /CHECKED ALL ? JMP CHKLUP /NO,GO BACK CHKEND, CLA /CLEAN UP TAD CHKCNT /GET COUNT SNA /DID WE FIND ANY ? JMP USE7 /NO,FORGET IT TAD L10 /YES,ADJUST TO UNIT DCA PRMUNT /SAVE IT USE7, TAD WFUN /GET WRITE OS/8 FUNCTION WORD TAD PRMUNT /ADD ON CURRENT UNIT DCA WFUN /STORE IT BACK TAD I L7607 /ANY OUTPUT FILES? SNA /SKIP IF ANY JMP MOVOUT /JUMP IF ONLY INPUT FILES TAD L7757 /UPDATE FILE LIST SZA /SKIP IF NO INPUT FILES DCA INZAP /SAVE PTR TO FIRST INPUT FILE DCA I INZAP /DESTROY INPUT FILES TAD I IN1 /\ DCA I IN2 / \ ISZ IN1 / \MOVE DOWN ISZ IN2 / /INLAP6 ROUTINE ISZ INCNT / / JMP .-5 // TAD BLOCK /GET DESIRED BLOCK DCA I PLPBLK /PUT INLINE TAD I PINFUN /GET LAP6W READ FUNCTION TAD PRMUNT /ADD ON DESIRED UNIT DCA I PINFUN /STORE IT BACK JMP I .+1 /NOW START CONVERTING INLAP6 /LAP6W INPUT MOVOUT, TAD I OUT1 /\ DCA I OUT2 / \ ISZ OUT1 / \MOVE DOWN ISZ OUT2 / /OUTPS8 ROUTINE ISZ OUTCNT / / JMP .-5 // JMP OUTPS8 /START CONVERSION OUT1, 0600 /WHERE OUTPS8 IS OUT2, GCH /WHERE IT GOES OUTCNT, GCH-ENDGCH /HOW MANY TO MOVE L10, 10 /CONSTANT 0010 L7604, 7604 /POINTER TO /A-/L L7606, 7606 /POINTER TO /Y-/9 L7607, 7607 /OUTPUT FILES L7756, 7756 /EQUALS PARM POINTER L7757, 7757 /FIRST FILE INZAP, INZAP /DESTROY THIS LOCATION IF NO INPUT FILES PINFUN, INFUN /WHERE UNIT ARGUMENT GOES PLPBLK, LAPBLK /POINTER TO WHERE ARG GOES IN1, 200 /WHERE IT IS NOW IN2, NEWBUF /WHERE IT BELONGS INCNT, NEWBUF-ENDPCH /HOW MANY TO MOVE CHKCNT, -10 /SWITCH CHECK COUNT