/FUTIL-OS/8 FILE UTILITY V6.16 3/22/77 / / OS/8 FILE UTILITY PROGRAM. ALLOWS EXAMINATION AND / MODIFICATION OF OS/8 MASS STORAGE DEVICES FROM THE CON- / SOLE. DUMPING OF BLOCKS, LISTING OF WORDS AND MODIFICA- / TION OF WORDS CAN BE DONE IN 7 FORMATS: OCTAL; SIGNED AND / UNSIGNED DECIMAL; UNPACKED, 6-BIT PACKED, COS PACKED AND / OS/8 PACKED ASCII. LISTING AND DUMPING CAN ALSO BE DONE / IN 5 MORE FORMATS: BCD, BYTE (OCTAL CHARACTER), 2 PSEUDO- / SYMBOLIC FORMATS [PDP-8 & FPP-12/8A], AND A COMBINATION / FORMAT FOR DIRECTORY DUMPING. PROGRAM USES BOTH COMMAND / WORDS AND COMMAND CHARACTERS (LIKE ODT) FOR DIRECTION. /BY: JIM CRAPUCHETTES / MENLO COMPUTER ASSOCIATES, INC. / (FORMERLY: FRELAN ASSOCIATES) / P.O. BOX 298 / MENLO PARK, CALIF. 94025 / / /VERSIONS 1 THRU 4 - "XTAPE" FOR THE XSYSTEM, / LAST REVISION--APRIL 1970. / /VERSION 5 - OS/8 OPERATION, JULY 1972 THRU JUNE 1976 / "(...)", "C & 'CC AS NUMBERS, IOT DECODING, LIST / & DUMP FORMATS, OUTPUT TO LPT:, FILE DATE & LOC / IN DIRECTORY, "WORD MEMREF...", BCD OUTPUT, / ADDITIONAL ODT OUTPUTS, "BYTE" OUTPUT. /VERSION 6 - EXPANSION OF OS/8 OPERATION, JUNE 1976: / "FILLER" FOR "MODIFY", SEARCH LIMITS CHANGE, "WRITE" / WITH AN ARGUMENT, FPP INSTRUCTION DECODING, CHAINING / SUPPORT (FOR CCL CALLS), LOAD MODULE HANDLING AND / "SHOW HEADER", MULTIPLE DEFAULT EXTENSIONS, ^R FOR / RETYPE, SET REPLACES OPTION, NEW OUTPUT ROUTINE FOR / "DIRECTORY" FORMAT, LINK OVERLAY HANDLING. /VERSION 6.10 - SEPT 28, 1976; ODT CHANGES, EXIT /VERSION 6.11 - NOV 16, 1976; SCAN, WRITE LOCKED /VERSION 6.12 - DEC 14, 1976; FIX RESTART,SPEED SEARCHES /VERSION 6.13 - DEC 17, 1976; FIX BUGS /VERSION 6.14 - JAN 13, 1977; BUGS!, COS OUTPUT FORMAT /VERSION 6.15 - JAN 18, 1977; COS PACKING /VERSION 6.16 - MAR 22, 1977; LDEV OUTPUT, FPP DECODE BUGS VERSION= 6^100 16 /OCTAL VERSION NUMBER / SOME ROUTINES AND IDEAS USED IN THIS PROGRAM WERE / DERIVED FROM EDIT-8 AND FOCAL, BY RICK MERRILL, DEC. / THE ODT COMMAND SET IS NEARLY IDENTICAL TO THE OS/8 / ODT COMMAND SET EXCEPT THAT 15 BIT ADDRESSES ARE USED / EVERYWHERE AND THERE ARE NO COMMANDS FOR PROGRAM EXECU- / TION. / THE DOUBLE PRECISION ARITHMETIC ROUTINES ARE A MUCH / MODIFIED VERSION OF DECUS 8-115A. / ASSEMBLY INFORMATION: / / .R PAL8 / *FUTIL 377)+IOBUF BLK, 0 /= "BLOCK" LOCH, 0 LOCL, 0 /= "LOCATION" (DISPLACEMENT) UBLK, 0 /UPPER LIMIT FOR SEARCHES ULOCH, 1 ULOCL, 7577 LBLK, 0 /LOWER LIMIT FOR SEARCHES LLOCH, 0 LLOCL, 200 SBLK, 0 /"LOCATION" FOR "ODT" ROUTINES SLOCH, 0 SLOCL, 0 OFFSET, 0 /OFFSET FILLER, 0 /FILLER CONSTANT FOR "MODIFY" MASK, -1 /MASK FOR WORD SEARCH SMASKL, -1 /= -(LENGTH OF SMASK) RBLK1, 0 /START BLOCK OF FILE DEVAD, 7607 /DEVICE ENTRY ADDR (INIT TO "SYS") DEVNO, 1 /DEVICE NUMBER (INIT TO "SYS") USRAD, 7700 /USR ADDRESS, INITIALIZED TO OUT /7700=MSGS IN; 0=NONE IN; 200=USR IN LPNT, 0 /USED BY LPT: OUTPUT /CONSTANTS M400, -400 M240, -240 M215, -215 M200, -200 M100, -100 M20, -20 M10, -10 M1, -1 N7, 7 N15, 15 N20, 20 N77, 77 N177, 177 N200, 200 N377, 377 N7000, 7000 N7400= M400 /ADDRESSES READCH= JMS I . /GET NEXT INPUT CHARACTER READ TYPSTI, TYPSTR TYPSI, TYPES TYPECI, TYPEC TWOCI, TWOCS CRLFI, CRLF DIGIT= JMS I . /OUTPUT AN ASCII DIGIT DODIG SPACE1= JMS I . /OUTPUT 1 SPACE OR ... DO1SP SPACE2= JMS I . /OUTPUT 2 SPACES DO2SP CTRLI, CTRL TWOT, PACOUT TYPEI, TYPE DECI, DPRT OCTI, OPRT DEC2I, DEC2 RTL6I, RTL6 RTR6I, RTR6 SOCTI, OCTSET BKLOCI, BKLOC EVALI, EVAL PUSH= JMS I . /PUSH AC ON P.D.L. PUSHX POP= JMS I . /POP P.D.L. INTO AC POPX CALUSR= JMS I . /DO USR FUNCTION USEUSR TADIDP= JMS I . /"TAD I DPNT" IN FIELD 1 TIDPNT TADICAD= JMS I . /"TAD I CAD" IN FIELD 1 TICAD DCAICAD= JMS I . /"DCA I CAD" IN FIELD 1 DICAD GWORDI, GWORD GARGI, GARGS ARGI, ARG GETI, GET ODGETI, ODGET GETNI, GETN SSKIPI, SSKIP LIMITI, LIMITS INCI, INC SORTI, SORTJ ENDCI, ENDC RETOPT, XSETN RECRLF, MAIN1-1 RESTAR, MAIN1 ERROR= JMS I . XERROR COMST, COMB-1 TEMPST, TEMPL-1 MASKBS, SMASKB-1 PAGE /PROGRAM MAIN LOOP AND DRIVER. COLLECTS CHARACTERS /INTO COMMAND BUFFER UNTIL END IS REACHED. DCA USRAD /CLEAR ON RESTART (NOTHING IN)! TLS /RAISE TELETYPE FLAG DCA SHUT /NOTHING IS OPEN JMS I CRLFI /OUTPUT CR-LF. MAIN1, JMS I SOCTI /SET INPUT TO OCTAL DCA LISTSW /RESET LIST OUTPUT SWITCH TAD COMST /INIT COMMAND BUFFER. DCA COMIR TAD (PDLB+1 /INIT PUSH-DOWN-LIST DCA PDLPT MAIN2, READCH /GET A CHAR FROM TTY. JMP MAIN1 /BUFFER WAS EMPTIED. JMS I SORTI /CHECK FOR TERMINATORS CCHARL-1 /CR LF ; ! / ALT- COPSL-CCHARL / MODES ETC... TAD CHAR /PUT CHAR IN BUFFER MAIN3, CDF 10 DCA I COMIR CDF 0 JMP MAIN2 /GET NEXT / /TREAT A TAB AS A SPACE FOR COMMAND INPUT MAIN4, TAD (" JMP MAIN3 /PUT A SPACE IN BUFFER /ROUTINE TO HANDLE CARRIAGE RETURN. CRCR, JMS I ENDCI /PUT A CR IN BUFFER JMP CRCRC /ONLY A CR IN BUFFER JMS I GWORDI /GET COMMAND WORD JMP CRCRN /BUFFER BEGINS WITH A # ISZ CRSWT /WORD ENDED BY A CR? JMP CRCR1 /YES, ONLY THREE OK JMS I SORTI /NO, LOOK UP COMMAND CWORDL-1 WOPSL-CWORDL ERCB, ERROR /NOT A LEGAL COMMAND / CRCR1, JMS I SORTI /ONLY "WRITE", "REWIND" & "EXIT" OK CWORL2-1 WOPSLL-CWORL2 ERCA, ERROR /SOMETHING NOT LEGAL / CRCRN, JMS CLOSE /CLOSE THE OPEN LOCATION IF OPEN CRCRC, DCA SHUT / MARK LOCATION CLOSED JMP MAIN1 /ROUTINE TO HANDLE SLASH SLASH, JMS I ENDCI /END BUFFER WITH A CR JMP SLA1 /OPEN LAST, CR ONLY JMS WCHEK /DOES LINE START W. A WORD? JMS I LIMITI /NO, GET ARG-- SBLK / & SLOCH & SLOCL SLA1, SPACE1 /OUTPUT SPACE SLO1, JMS ODTOUT /GET THE WORD & OUTPUT SLO2, SPACE1 /FOLLOWED BY 2 SPACES SPACE1 /(FOR ";"--OUTPUT ONLY 1 SPACE AND JMS I ODGETI / THEN FORCE ACTION & IGNORE VALUE) STA JMP CRCRC /GO MARK LOCATION OPEN /ROUTINE TO HANDLE ALT MODE & ESCAPE KEYS ALTMOD, TAD OUTPNT /USE OUTPUT ROUTINE 'SET' BY JMP ALTM1 / 'FORMAT' OPTION. /ROUTINE TO CLOSE A LOCATION, OUTPUT ITS (NEW) CONTENTS IN A / SPECIFIED FORMAT AND THEN RE-OPEN. THE ROUTINE HANDLES: / # (BCD), $ (OS/8 ASCII), % (BYTE OCTAL), & (COS ASCII), / : (SIGNED DECIMAL), < (OCTAL), = (UNSIGNED DECIMAL), / > (PDP SYMBOLIC), @ (DATE), [ (ASCII), \ (FPP SYMBOLIC), / ] (PACKED ASCII) AND ? (DIRECTORY). / OMODES, TAD SCANX1 /'SORTJ' POINTER TO CHAR LIST TAD (OTABLE-1-CCHARL DCA DPNT /POINT INTO ADDR TABLE, TADIDP / GET OUTPUT ROUTINE ADDR, ALTM1, DCA OMODPT / & SET POINTER TO ROUTINE. JMS ECLOSE /CLOSE THIS LOCATION SPACE1 /OUTPUT SPACE DCA CHARSW /RESET UNPACK SWITCH JMS I ODGETI /GET WORD JMS I OMODPT /OUTPUT IN DESIRED FORMAT JMP SLO2 /AND GO REOPEN. OMODPT, 0 /ROUTINE TO HANDLE BACKARROW. BACKAR, JMS ECLOSE /CLOSE THIS LOCATION TADICAD /GET THE CONTENTS, JMP UPARR1 /AND USE THEM AS THE ADDR /ROUTINE TO HANDLE UPARROW. UPARR, JMS ECLOSE /CLOSE THIS LOCATION TADICAD /IS THIS A 'PAGE 0' REF.? AND N200 SZA CLA TAD SLOCL /YES, USE PAGE BITS AND M200 / MASK PAGE OR 0 TO PAGE # DCA SLOCL / & SAVE IT TADICAD /GET THE CONTENTS, AND N177 /AND USE THE ADDRESS BITS. TAD SLOCL / ALONG WITH PAGE BITS UPARR1, DCA SLOCL /THIS IS 12 BIT ADDR JMP EXCL2 /NOW GO FINISH /ROUTINE TO HANDLE SEMICOLON, LINE FEED & EXCLAMATION. SEMIC, DCA I READCH-4400 /SET NO-OUTPUT SWITCH LFLF, STA /LINE-FEED - CLOSE,INCREMENT,OUTPUT EXCL, DCA OMODPT /EXCLAMATION - CLOSE,DECREMENT,OUTPUT JMS ECLOSE /CLOSE THIS LOCATION IAC DCA ACC1 /SET UP D.P. INCREMENT DCA ACC2 EXCL1, DCA DPSGN /(FOR SAFETY) ISZ OMODPT /INCREMENT OR DECREMENT? JMS DPNEG / DECREMENT, NEGATE VALUE CLL TAD ACC1 TAD SLOCL /UPDATE LOCATION TO 15 BITS DCA SLOCL RAL TAD ACC2 TAD SLOCH AND N7 / (BUT ONLY 15 BITS) DCA SLOCH TAD I READCH-4400 / ANY OUTPUT? SNA CLA JMP SLO2+1 / NO, WAS ";" DO ONE SPACE EXCL2, JMS I CRLFI /GIVE CR/LF FOR NEXT LINE JMS I BKLOCI /OUTPUT ADDRESS SBLK-1 JMS I TWOCI /OUTPUT "\ " 3440 JMP SLO1 /NOW GO OPEN NEXT LOCATION /ROUTINE TO HANDLE PLUS & MINUS. PLUS, STA /"+", SET SWITCH MINUS, DCA OMODPT /"-", CLEAR SWITCH JMS I ENDCI /END BUFFER, TEST JMP EXCL2 /NO ARG, DO SAME AGAIN JMS WCHEK /LINE START WITH A COMMAND? JMS I ARGI /NO, GET AN ARG JMP EXCL1 /UPDATE LOC & GO OPEN ECLOSE, 0 /SUB. TO CLOSE THE LOCATION IF ARG. JMS I ENDCI /END BUFFER WITH A CR. JMP I ECLOSE /ONLY A CR IN BUFFER, DONE JMS WCHEK /DOES LINE START W. A WORD? JMS CLOSE /ARG IN BUFFER, USE IT JMP I ECLOSE /DONE PAGE /ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC / EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED / DECIMAL. XVAL, JMS I EVALI /GO EVALUATE TAD CHAR /ENDED BY A CR? TAD M215 SZA CLA ERCC, ERROR /NO, SORRY!--TOO MANY ")"S JMS I TWOCI /"= " 7540 TAD ACC2 JMS I OCTI /OUTPUT HIGH ORDER IN OCTAL TAD ACC1 JMS I OCTI /OUTPUT LOW ORDER IN OCTAL TAD ACCX1 /SAVE REMAINDER FOR LATER DCA COMIR TAD ACCX2 DCA COMOUT TAD (-7 DCA XERROR /MUST DEVELOP 7 DIGITS JMS I TWOCI /OUTPUT " (" 4050 TAD ACC2 /IS DPAC NEG? SMA CLA JMP DLOOP1-1 /NO, OUTPUT " " JMS DPNEG /YES, MAKE IT POSITIVE TAD N15 / AND OUTPUT "-". SPACE1 DLOOP1, TAD (12 /RESET DIVISOR TO 10(10) DCA OPER1 DCA OPER2 JMS DDIV /GO DIVIDE DPAC BY 10(10) TAD ACCX1 / GET REMAINDER PUSH /PUT IT ON PUSH-DOWN-LIST ISZ XERROR /DONE YET? JMP DLOOP1 TAD COMOUT /YES, RESTORE REMAINDER DCA ACCX2 TAD COMIR DCA ACCX1 TAD (-7 DCA XERROR /NOW SET UP TO OUTPUT 7 DIGITS DLOOP2, POP / IN REVERSE ORDER! DIGIT /MAKE REMAIN A DIGIT ISZ XERROR /DONE? JMP DLOOP2 JMS I TYPECI /YES, OUTPUT ")" ") JMP I RECRLF / AND CR/LF /ERROR ROUTINE XERROR, 0 STA /CLEAR POSSIBLE JUNK FROM AC TAD XERROR / & BACK UP TO CALL ADDR. DCA XERROR DCA LISTSW /RESET IN CASE LISTING CDF 0 JMS I TYPECI /OUTPUT "?" "? TAD (ERLIST-1 /INIT LIST POINTER DCA DPNT DCA TEMP /SET CODE TO 0 XERR1, ISZ TEMP /BUMP ERROR CODE TADIDP /GET AN ADDRESS SNA JMP XERR2 /(FOR DEBUGGING) CIA TAD XERROR /DOES IT MATCH THE CALL? SZA CLA JMP XERR1 /NO XERR2, TAD TEMP /YES, OUTPUT ERROR CODE JMS I DEC2I / AS 2 DECIMAL DIGITS JMS I TYPSI /NOW OUTPUT " AT " MS17 TAD (-COMB+1 /CALCULATE POSITION IN TAD COMOUT / COMMAND BUFFER, JMS I DEC2I / & OUTPUT AS 2 DIGITS. XERR3, TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS -> SZA CLA / "JMP I RECRLF" IF 'USROUT' ERROR!] JMP I RECRLF /SHORT, GO DO CR/LF JMS USROUT /LONG, BE SURE MESSAGES ARE IN SPACE2 /OUTPUT 2 SPACES TAD TEMP /CODE = ADDRESS-1 OF ADDRESS DCA DPNT / OF MESSAGE TADIDP /GET MESSAGE ADDR JMS I TYPSTI / OUTPUT MESSAGE JMP I RECRLF / DO CR/LF USEUSR, 0 /USR CALLER SUBROUTINE DCA USRSAV /SAVE CONTENTS OF AC TAD USRAD /IS USR IN OR OUT? SMA SZA CLA JMP USRIN /IN, GO TO IT CIF 10 JMS I M100 /OUT, DO "USRIN" FUNCTION 10 TAD N200 DCA USRAD / & SO INDICATE USRIN, CDF CIF 10 TAD USEUSR /MOVE RETURN ADDRESS TO THE DCA I N200 / USR ENTRY POINT CDF 0 TAD USRSAV /RESTORE AC CONTENTS JMP I (201 / & FAKE A CALL TO IT USRSAV, USROUT, 0 /SUBROUTINE TO REMOVE USR BY RECALLING ERC15, TAD USRAD / ERROR MESSAGES FROM SCRATCH SPA CLA / BLOCKS ON SYS. JMP I USROUT /JUST EXIT IF PRESENT... TAD M100 DCA USRAD /SET USR TO "OUT" JMS I (7607 /READ IN THE MESSAGES 610 / 6 PAGES TO FIELD 1 0 / STARTING AT LOC 10000 27 / FROM SCRATCH BLKS SKP CLA /!!! ERROR !!! JMP I USROUT /OK, JUST EXIT TAD XERR3+2 DCA XERR3 /NO MORE MESSAGES ON ERROR! TAD ERCC DCA ERC15 /AND NO MORE "SHOW ERROR"! ERC16, ERROR /TELL THE HORRIBLE STORY! PAGE /ROUTINE TO EXECUTE THE BLOCK 'SCAN' COMMAND XSCAN, JMS I GARGI /GET ARGS CONVERTED TAD (SCANER / & SET UP FOR SCANNING JMP XDUM0 /ROUTINE TO EXECUTE THE BLOCK 'DUMP' COMMAND XDUMP, TAD MODSW /MAPPED MODE? SMA SZA CLA ERC14, ERROR /YES, DUMP IS MEANINGLESS! JMS XDLCOM /DO COMMON STUFF TAD (LLIST / & SET UP FOR DUMPING XDUM0, DCA XGFORM /SET OUTPUT ROUTINE--DUMP/SCAN XDUM1, ISZ DPNT /SKIP FIRST WORD ISZ DPNT /SKIP A WORD TAD I DPNT /GET NEXT START BLOCK. JMS BLKTST TAD I DPNT /GET NEXT -(# BLOCKS) DCA TEMP1 XDUM2, JMS I CTRLI /TEST HERE FOR 'SCAN' TERMINATE DCA LOCL /SET LOC TO 0 DCA LOCH TAD M400 /SET TO -400(8) [1 BLOCK] JMS I XGFORM /DUMP OR SCAN A BLOCK ISZ BLK /INCREMENT BLOCK NUMBER ISZ TEMP1 /DONE? JMP XDUM2 /NO, DO NEXT BLOCK ISZ TEMP /YES, ARE ALL ARGS DONE? JMP XDUM1 /NO, DO NEXT JMP XLIS2 /YES, DONE--RESET SWITCH /ROUTINE TO EXECUTE THE LOCATION 'LIST' COMMAND XLIST0, JMS XDLCOM /DO COMMON STUFF XLIS1, TAD I DPNT /GET BLOCK # JMS BLKTST /TEST & SET BLK TAD I DPNT /GET & SET LOCATION DCA LOCH TAD I DPNT DCA LOCL TAD I DPNT /GET -(# WORDS) JMS LLIST /NOW GO DO IT ISZ TEMP /ARE ALL ARGS USED? JMP XLIS1 /NO, CONTINUE XLIS2, DCA LISTSW /RESET LISTING SWITCH JMP I RECRLF / DO CR/LF & CONTINUE /COMMON SUBROUTINE FOR 'XDUMP'&'XLIST0' XDLCOM, 0 TAD OUTPNT /INITIALIZE DEFAULTS DCA LISTPT TAD OUTSW DCA LOUTSW JMS XGFORM /GET FORMAT, IF ANY NOP /RETURN FOR NO FORMAT JMS I GARGI /GET ARGS ISZ LISTSW /SET LISTING SWITCH JMP I XDLCOM /SUBROUTINE TO OUTPUT -[C(AC)] WORDS FROM THE DEVICE /BEGINNING AT BLK.LOC IN THE SPECIFIED FORMAT LLIST, 0 DCA CNTRA /SET UP -# WORDS TO LIST DCA CHARSW /RESET UNPACK SWITCH LLIS1, JMS I CRLFI TAD LOCL AND N7 /SET UP # ON THIS LINE DCA CNTR TAD LOUTSW /IF CHARACTER OUTPUT, SNA CLA TAD M10 / DOUBLE # WORDS/LINE TAD CNTR TAD M10 DCA CNTR JMS I BKLOCI /OUTPUT LOCATION BLK-1 JMS I TYPSI /OUTPUT ": " MS13 LLIS2, JMS I GETI /GET A WORD JMP LLIS3 /FILE MODE, NO SUCH ADDR.. JMS I LISTPT /OUTPUT IT TAD LOUTSW /TEST MODE SWITCH SPA JMP LLIS5 /"SYMBOLIC", CR/LF NOW SZA CLA /CHARACTERS, NO SPACES SPACE2 /NUMBERS, TWO SPACES LLIS3, JMS I INCI /INCREMENT LOC ISZ CNTRA /ALL WORDS DONE? JMP LLIS4 /NO JMS I CRLFI JMP I LLIST /YES, RETURN / LLIS4, ISZ CNTR /ALL DONE WITH THIS LINE? JMP LLIS2 /NOT YET JMP LLIS1 /YES, OUTPUT CR/LF & CONTINUE / LLIS5, STA DCA CNTR /FORCE A CR/LF JMP LLIS3 LISTPT, 0 LOUTSW, 0 /SUBROUTINE TO GET A FORMAT FOR 'XFORM' & 'XDLCOM' XGFORM, 0 JMS I GWORDI /GET A WORD JMP I XGFORM /NOT FOLLOWED BY A WORD JMS I SORTI /LOOK UP WORD FORML-1 FOPSL-FORML ERCD, ERROR /WORD NOT RECOGNIZED / XFSYM, STL RAR /"SYMBOLIC"; SWITCH NEG XFNUM, IAC /NUMERIC; SWITCH POS XFCHR, DCA LOUTSW /CHARACTER; SWITCH 0 TAD SCANX1 /'SORTJ' POINTER TO CHAR TAD (-FORML /CALCULATE FORMAT # CLL RAR /(DIVIDE BY 2) DCA TEMP1 / & SAVE IT. TAD TEMP1 TAD (FTABLE-1 DCA DPNT TADIDP DCA LISTPT /SET UP OUTPUT POINTER ISZ XGFORM /BUMP RETURN ADDRESS JMP I XGFORM /ROUTINE TO 'SET' THE 'FORMAT' OPTION XFORM, JMS XGFORM /GET FORMAT WORD ERCE, ERROR /NUMBER?! SORRY ABOUT THAT! TAD LOUTSW /OK, SET UP DEFAULTS: DCA OUTSW / SWITCH, TAD LISTPT DCA OUTPNT / ROUTINE POINTER, TAD TEMP1 DCA FCNT / & FORMAT # JMP I RETOPT OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF PAGE /ROUTINE TO EXECUTE THE 'FILE' COMMAND. XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS? SPA CLA JMP XFITRY / NO, TRY NEXT EXTENSION JMS PNAME /YES, OUTPUT FILE NAME & JMS I TYPSI /"LOOKUP FAILED" MS15 / XFILEN, JMS I CRLFI /OUTPUT CR/LF ISZ CRSWT /WAS LAST ENDED BY A CR? JMP I RESTAR /YES, DONE XFILE, STA /"." LEGAL IN FILE NAME JMS GNAME /GET NEXT FILE NAME XFICHN, STA DCA DPSGN /SET TRY AGAIN SWITCH TAD (NAM1 /INIT POINTER TO NAME DCA FSTBLK TAD DEVNO /GET DEVICE # CALUSR 2 /LOOKUP FSTBLK, 0 /NAME PNTR, BECOMES ST BLK FBKLEN, 0 / BECOMES -(FILE LENGTH) JMP XFIERR /LOOKUP FAILED TAD FSTBLK DCA RBLK1 /SET UP PAGE 0 ST BLK CDF 10 DCA I (CCBB / & RESET CCBB TAD I (1404 /GET # ADD'L INFO WORDS DCA XDEV2 / (NEGATIVE) & SAVE IT TAD XDEV2 TAD I (17 /POINT TO FIRST OF THEM DCA XDEV3 / (THE DATE, IF PRESENT) TAD I N7 /GET THE NUMBER OF THE AND N7 / DIRECTORY SEGMENT IN DCA CNTR / CORE & SAVE IT. TAD XDEV2 /WAS # OF ADD'L WRDS = 0? SZA CLA TAD I XDEV3 / NO, GET THE DATE WORD CDF 0 DCA XDEV1 /STORE DATE OR 0 (NO DATE) JMS PNAME /OUTPUT FILE NAME TAD FSTBLK JMS I OCTI /OUTPUT ST. BLK. IN OCTAL JMS I TYPECI "- TAD FBKLEN /CALCULATE LAST BLK # CMA TAD FSTBLK JMS I OCTI / & OUTPUT IN OCTAL SPACE2 /OUTPUT 2 SPACES TAD FBKLEN CIA JMS I OCTI /OUTPUT LENGTH IN OCTAL JMS I TWOCI /" (" 4050 TAD FBKLEN CIA JMS I DECI / & AGAIN IN DECIMAL JMS I TYPSI /") " MS33 TAD CNTR /GET SEGMENT # JMS I RTL6I / & PUT IN BITS 3-5 JMS I TWOCI / TO OUTPUT IT & "." 6056 TAD XDEV3 /GET ADDR OF 1ST ADD'L WRD TAD (-1400-4 / FOR OFFSET OF NAME START JMS OCT3 /OUTPUT LOCATION IN SEG SPACE2 / & TWO SPACES TAD XDEV1 /GET DATE WORD SZA /IS IT = 0? JMS PDATE /NO, OUTPUT DATE JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE PDATE, 0 /ROUTINE TO OUTPUT A DATE WORD DCA XDEV1 /SAVE IT TAD XDEV1 JMS I RTR6I /MONTH (0-3) TO 8-11 RTR AND (17 /MASK IT JMS I DEC2I / & OUTPUT IN 2 DIGIT DECIMAL JMS I TYPECI /FOLLOWED BY "/" "/ TAD XDEV1 /GET WORD AGAIN & MASK AND N377 CLL RTR /DAY (4-8) TO 7-11 RAR JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED) JMS I TYPECI / & ANOTHER "/" "/ TAD XDEV1 /GET LAST TIME AND N7 / MASK OFF YEAR TAD YRBASE / ADD TO BASE YEAR (70) JMS I DEC2I / & OUTPUT IT JMP I PDATE DECIMAL YRBASE, 70 /BASE YEAR FOR DATE OCTAL /ROUTINE TO 'SET' THE 'DEVICE' OPTION XDEV, JMS GNAME /GET DEV NAME ("." ILLEGAL) TAD NAM1 /MOVE NAME TO CALL DCA XDEV1 TAD NAM2 DCA XDEV2 TAD (DEVHAN+1 /2 PAGE HANDLER OK DCA XDEV3 CALUSR 1 /FETCH HANDLER XDEV1, 0 XDEV2, 0 XDEV3, 0 ERCY, ERROR /NO SUCH HANDLER TAD XDEV3 /SET UP HANDLER ADDRESS DCA DEVAD TAD XDEV2 /SAVE DEVICE # DCA DEVNO DCA RBLK1 / & NO FILE KNOWN DCA SHUT / & NOTHING OPENED DCA MODIF / & NOTHING MODIFIED TAD NAM1 CIF 10 JMP XDEVM /GO FINISH SETUP IN FIELD 1 PAGE /ROUTINE TO EXECUTE THE 'SHOW' COMMAND XSHBLK, JMS I TYPSI /"BLOCK = " MS32 TAD RBLK1 /OUTPUT BLOCK IN OCTAL XSTYPE, JMS I OCTI XSHCR, JMS I CRLFI /GIVE A CR & LF DCA LISTSW /BE SURE SWITCH IS RESET ISZ CRSWT /LAST WORD ENDED BY CR? JMP I RESTAR /YES, DONE XSHOW, JMS I GWORDI /GET A WORD JMP ERCG /NUMBERS NOT RECOGNIZED JMS I SORTI /LOOK IT UP SHOWL-1 SHOWOP-SHOWL ERCG, ERROR /NOT FOLLOWED BY LEGAL WORD XSHVER, JMS I TYPSI /"VERSION = AA.BB" MSVER JMP XSHCR XSHMSK, JMS I TYPSI /"MASK = " MS02 TAD MASK JMP XSTYPE XSHOFF, JMS I TYPSI /"OFFSET = " MS09 TAD OFFSET CIA JMP XSTYPE XSHFIL, JMS I TYPSI /"FILLER = " MS37 TAD FILLER JMP XSTYPE XSHODL, JMS I TYPSI /"ODT LOC = " MS12 JMS I BKLOCI /OUTPUT IT SBLK-1 JMP XSHCR XSHREL, JMS I TYPSI /"REL. LOC = " MS20 JMS I BKLOCI / & OUTPUT IT BLK-1 JMP XSHCR XSHABS, JMS I TYPSI /"ABS. LOC = " MS03 TAD CAD /OUTPUT LOCATION IN BLOCK TAD (-IOBUF DCA CAD JMS I BKLOCI CBLK-1 JMP XSHCR XSHUPP, JMS I TYPSI /"UPPER = " MS04 JMS I BKLOCI /OUTPUT IN BLOCK.LOC FORM UBLK-1 JMP XSHCR XSHLOW, JMS I TYPSI /"LOWER = " MS05 JMS I BKLOCI LBLK-1 JMP XSHCR XSHFMT, JMS I TYPSI /"FORMAT = " MS06 TAD FCNT TAD (FMTLS-1 /SET UP FOR CORRECT TITLE XSHFM, DCA DPNT TADIDP /GET MESSAGE ADDRESS JMS I TYPSTI /OUTPUT DESCRIPTOR JMP XSHCR XSHMOD, JMS I TYPSI /"MODE = " MS10 TAD MODSW /GET CORRECT MESSAGE TAD (MODELS-1 /(OFFSET INTO TABLE) JMP XSHFM /GET ADDRESS & OUTPUT XSHOUT, JMS I TYPSI /"OUTPUT = " MS30 TAD TYPSW /SET UP MESSAGE ADDRESS TAD (OUTLS-1 /(OFFSET INTO TABLE) JMP XSHFM XSHSMS, JMS I TYPSI /"SMASK = " MS07 TAD SMASKL DCA TEMP /-# TO OUTPUT TAD MASKBS DCA DPNT /SET UP TO OUTPUT TAD M10 /SET LINE LENGTH DCA TEMP1 JMP XSHSM2 XSHSM1, JMS I TWOCI /OUTPUT ", " 5440 ISZ TEMP1 /ENOUGH ON THIS LINE? JMP XSHSM2 /NO, OK JMS I CRLFI /YES, OUTPUT CR-LF SPACE2 / & 2 SPACES STA /MAKE LINE 1 LONGER JMP XSHSM1-3 /AND RESET LENGTH / XSHSM2, TADIDP /GET NEXT VALUE JMS I OCTI / & OUTPUT IT ISZ TEMP /ENOUGH? JMP XSHSM1 JMP XSHCR /OK, GET NEXT WORD XSHDEV, JMS I TYPSI /"DEVICE = XXXX" MSDEV JMS I TWOCI /NOW OUTPUT " (" 4050 TAD DEVNO /GET THE DEVICE # JMS I DEC2I / & OUTPUT AS 2 DIGITS JMS I TYPECI /FINALLY OUTPUT ")" ") JMP XSHCR FPRNT, 0 /PRINT FIELD DIGIT FROM BITS 6-8 RTR /MOVE TO BITS 9-11 RAR AND N7 /MASK TO 1 DIGIT DIGIT / & OUTPUT IN ASCII JMP I FPRNT /PART OF 'XFILE'--DO EXTENSION RETRIES: "LD",NULL XFITRY, ISZ DPSGN /THIS WILL SKIP ON 1ST FAIL ISZ TEMP1 /THIS WILL SKIP ON 2ND FAIL TAD (1404 / 2ND TRY--USE "LD" EXTEN DCA NAM4 / 3RD TRY--USE NULL EXTEN JMP XFICHN+2 / 3RD TRY IS FINAL FAILURE PAGE /CONTINUATION OF 'SHOW' COMMAND /SHOW 'CCB' HANDLER XSHCCB, CDF CIF 10 JMS GCCB /SET UP CCB FOR FILE DCA DPSGN / & SET UP SEGMENTS JMS I TYPSI /"CCB:" MS11 JMS CCHDST /DO SETUP, OUTPUT START JMS I TYPSI /", JSW = " MS19 JMS NXTOCT /OUTPUT J.S.W. IN OCTAL JMS I CRLFI JMS I TYPSI /" CORE SEGS: " MS14 XSHCC1, TAD (-4 DCA CNTR /-#/LINE XSHCC2, TADIDP /GET ORIGIN WORD DCA TEMP1 TADIDP / & COUNT WORD DCA TEMP2 TAD TEMP2 /GO OUTPUT START FIELD JMS FPRNT TAD TEMP1 / & START ADDR JMS I OCTI JMS I TYPECI / & A "-" "- TAD TEMP2 /OUTPUT FIELD AGAIN JMS FPRNT TAD TEMP2 / PAGE COUNT -> PAGES CLL RAL AND M200 /MASK OFF FIELD DATA TAD TEMP1 /ADD ORIGIN ADDR TAD M1 / & SUBTRACT 1 FOR END JMS I OCTI /OUTPUT END ADDR IN OCTAL ISZ DPSGN /DONE? JMP XSHCC4 /NO TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT) SNA JMP XSHCR / NO, DONE DCA DPNT / YES, RESET POINTER JMP XSHHD1 / & CONTINUE / XSHCC4, JMS I TWOCI /OUTPUT SEPARATOR 5440 ISZ CNTR /DONE ON THIS LINE? JMP XSHCC2 /NO JMS I CRLFI /YES SPACE2 /ADD 2 SPACES STA /AND 1 MORE ITEM PER LINE JMP XSHCC1 /SHOW 'HEADER' HANDLER XSHHDR, CDF CIF 10 JMS GHDR /SET UP HEADER FOR MODULE JMS I TYPSI /"HEADER:" MS38 JMS CCHDST /DO SETUP, OUTPUT START JMS I TYPSI /", NEXT WORD = " MS39 TADIDP /GET FIELD DIGIT DIGIT / & OUTPUT JMS NXTOCT /FOLLOWED BY ADDRESS JMS I TYPSI /", LOAD VER = " MS40 JMS NXTOCT / & OUTPUT VERSION TADIDP /GET E.P. FLAG SNA CLA JMP XSHHD1 / NO E.P. JMS I TYPSI /", EP REQ'D" MS41 XSHHD1, JMS I CRLFI /TO THE NEXT LINE JMS I TYPSI /" OVLYS START... MS42 XSHHD2, TADIDP /GET NUMBER OF OVERLAYS SNA / FOR THIS LEVEL JMP XSHCR / 0 = END, DONE DCA TEMP1 /SAVE IT JMS I CRLFI /OUTPUT A CR/LF SPACE2 / AND 4 SPACES SPACE2 TAD TEMP1 JMS I DEC2I /# OVLYS IN DECIMAL SPACE2 TADIDP /GET MEMORY START WORD DCA TEMP2 TAD TEMP2 JMS FPRNT /OUTPUT START FIELD TAD TEMP2 AND M400 / & DOUBLE-PAGE JMS I OCTI SPACE2 JMS NXTOCT /OUTPUT RELATIVE BLOCK SPACE2 JMS NXTOCT /OUTPUT OVERLAY LENGTH JMP XSHHD2 /AND DO ANOTHER ROUND! /SHOW 'ERRORS' HANDLER XSHERR, JMS USROUT /BE SURE MESSAGES ARE IN ISZ LISTSW /SET LISTING SWITCH JMS I TYPSI /"ERRORS: FUTIL VERSION ..." MSERR JMS I CRLFI CLA IAC DCA DPNT /SET POINTER & CODE XSHER1, JMS I CRLFI /DO ANOTHER CR/LF TAD DPNT /TEST FOR LAST REAL MESSAGE TAD (-EMSEND /(NOT DEBUG MESSAGE!) SNA CLA JMP XSHCR TAD DPNT /OUTPUT ERROR CODE JMS I DEC2I / AS 2 DIGITS JMS I TYPSI /THEN " = " MS01 TADIDP /GET ADDR OF MESSAGE AND JMS I TYPSTI / OUTPUT IT JMP XSHER1 CCHDST, 0 JMS I CRLFI JMS I TYPSI /" SA = " MS18 TAD (CCBB DCA DPNT /SET UP POINTER TO DATA TADIDP /GET 2ND WORD FROM CCB/HDR JMS FPRNT /IT HAS START FIELD SO OUTPUT JMS NXTOCT / FOLLOWED BY START ADDR JMP I CCHDST PAGE /ROUTINE TO EXECUTE THE 'SET' COMMAND XSETN, ISZ CRSWT /WAS LAST INFO ENDED BY CR? JMP I RESTAR /YES, DONE XSET, JMS I GWORDI /GET OPTION WORD JMP XSET1 /NO NUMBERS PLEASE! ISZ CRSWT /WAS WORD ENDED BY A CR? ERCK, ERROR /YES, ILLEGAL HERE JMS I SORTI /LOOK UP WORD OPTLST-1 OPTJMP-OPTLST XSET1, ERROR /WHAT??? /ROUTINE TO 'SET' THE 'LDEV' (LISTING DEVICE) XLDEV, JMS I GWORDI /GET A WORD JMP ERC11 /NO NUMBERS HERE! JMS I SORTI /LOOK IT UP XLDLST-1 XLDOPS-XLDLST ERC11, ERROR /NO LIKEE!! / XLDLPT, TAD (4020 /CODED "LPT" DCA XLDLC1 DCA XLDLC2 /SET UP NAME TAD (LISHAN+1 /TWO PAGES FOR HANDLER DCA XLDLC3 /SET IT UP CALUSR 1 /FETCH "LPT" HANDLER XLDLC1, 0 XLDLC2, 0 XLDLC3, 0 ERC12, ERROR /FETCH FAILED TAD XLDLC3 /GET ENTRY POINT ADDRESS XLDTTY, DCA LISTAD /SET OR RESET LPT OUTPUT TAD (OUTBUF /INIT OUTPUT POINTER DCA LPNT JMP I RETOPT /ROUTINE TO 'SET' THE 'OUTPUT' OPTION XOUTS, JMS I GWORDI /GET OPTION WORD JMP ERCL / # IN THE BUFFER JMS I SORTI /LOOK IT UP XOLST-1 XOOPS-XOLST ERCL, ERROR /NOT FOLLOWED BY LEGAL WORD / CLL STA RAL /-1: 'FPP' (SYMBOLIC) XOUTS1, IAC /+1: 'PDP' (SYMBOLIC) DCA TYPSW / 0: 'OCTAL' JMP I RETOPT /ROUTINE TO 'SET' THE 'MASK' OPTION XMASK, JMS I ARGI /GET ONE ARG TAD ACC1 /GET 'LOC' DCA MASK / & SET MASK JMP I RETOPT /ROUTINE TO 'SET' THE 'OFFSET' OPTION XOFFS, JMS I ARGI /GET ONE ARG TAD ACC1 /GET # CIA DCA OFFSET /SET IT JMP I RETOPT /ROUTINE TO 'SET' THE 'ERROR' (MODE) OPTION XEMODE, JMS I GWORDI /GET WORD JMP ERCZ /NO NUMBERS ALLOWED!!! JMS I SORTI /LOOK IT UP XELST-1 XEOPS-XELST ERCZ, ERROR /ILLEGAL SOMETHING / XEMOD1, IAC /'SHORT' DCA ERMODE /'LONG' JMP I RETOPT /ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION XUPP, JMS I LIMITI /UPPER, GET ARGS UBLK JMP I RETOPT /ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION XLOW, JMS I LIMITI /LOWER, GET ARGS LBLK JMP I RETOPT /ROUTINE TO 'SET' THE 'MODE' OPTION XMODE, JMS I GWORDI /GET OPTION WORD JMP ERCJ /NUMBER IN BUFFER, BAIL OUT JMS I SORTI /LOOK IT UP MODLST-1 MODOPS-MODLST ERCJ, ERROR /NOT RECOGNIZED / CLL STA RTL /-1: OFFSET XMODS, IAC /+2: LOAD (MODULE) IAC /+1: SAVE (FILE) DCA MODSW / 0: NORMAL JMP I RETOPT /ROUTINE TO 'SET' THE 'FILLER' OPTION XFILL, JMS I ARGI /GET ONE ARG TAD ACC1 DCA FILLER / & SET AS FILLER JMP I RETOPT /SUBROUTINE TO GET A NUMERIC ARGUMENT FROM THE / COMMAND BUFFER AND RETURN IT TO THE 3 WORDS / POINTED TO BY CALL+1. THE FIRST WORD (BLOCK / NUMBER) IS NOT CHANGED IF NO BLOCK PART WAS / GIVEN IN THE COMMAND. LIMITS, 0 TAD I LIMITS /GET ADDRESS OF 3 WORDS ISZ LIMITS DCA ABKLOC / & SAVE IT JMS I ARGI /GET COMMAND DATA TAD TEMP1 /GET BLOCK NUMBER PART ISZ TEMP1 /WAS A BLOCK PART SPEC'D? DCA I ABKLOC / YES, STORE IT CLA /(CLEAR IN CASE NOT!) ISZ ABKLOC /BUMP POINTER TAD ACC2 AND N7 DCA I ABKLOC /STORE HIGH 3 BITS ISZ ABKLOC TAD ACC1 DCA I ABKLOC / & LOW 12 BITS OF ADDR. JMP I LIMITS /ROUTINE TO OUTPUT LOCATION THAT SATISFIED ONE /OF THE SEARCH COMMANDS. IF ABSSW=0, OUTPUT /AS RELATIVE LOCATION. ABKLOC, 0 TAD ABSSW /IS IT 0? SZA CLA JMP ABK2 /NO, OUTPUT AS ABSOLUTE JMS I BKLOCI /OUTPUT LOCATION BLK-1 ABK1, JMS I TWOCI /OUTPUT ": " 7240 JMS I TWOT JMP I ABKLOC / ABK2, TAD LOCL /MAKE ABSOLUTE AND N377 DCA CAD JMS I BKLOCI /NOW OUTPUT IT CBLK-1 JMP ABK1 TWOCS, 0 /OUTPUT 2-CHARACTER ARG TAD I TWOCS /GET ARG ISZ TWOCS /SKIP IT JMS I TWOT /OUTPUT IT JMP I TWOCS NXTOCT, 0 TADIDP /GET NEXT WORD FROM BLOCK JMS I OCTI / & OUTPUT IN OCTAL JMP I NXTOCT PAGE /ROUTINE TO EXECUTE THE 'WORD' SEARCH COMMAND XWORD, JMS SSET /INITIALIZE SEARCH TAD CNOP /SET UP FOR NORMAL, DCA CNOP+1 TAD M10 / EQUAL SEARCH XWOR2, TAD (SNA CLA /"UNEQUAL" WORD SEARCH DCA XWORC XWOR1, JMS I GWORDI /GET POSSIBLE WORD JMP XWOR3 /NUMBERS IN BUFFER ISZ CRSWT /WAS IT ENDED BY A CR? ERCI, ERROR /YES, VELLY SOLLY! JMS I SORTI /LOOK UP COMMAND: UN, ME, XWORCL-1 / AB, FR, TO XWOROP-XWORCL ERCH, ERROR /COMMAND NOT RECOGNIZED / XWOR7, TAD XWOR4+1 /"MEMREF", ONLY MEMORY- DCA CNOP+1 / REFERENCE OP-CODES CAN JMP XWOR1 / EVER BE OUTPUT. / XWOR3, JMS I ARGI /GET AN ARG TAD ACC1 /GET THE VALUE AND MASK CIA DCA CNT /LOOK FOR THIS WORD JMS LSETUP /SET UP COUNT OF WORDS TO DO XWOR4, JMS I GETI /GET A WORD JMP XWOR5 /FILE MODE, NO SUCH ADDRESS AND MASK TAD CNT XWORC, HLT /WILL BE "SZA CLA" OR "SNA CLA" JMP XWOR5 /DID NOT MATCH JMS OPRTST /TEST FOR OP-CODES 6 & 7 CNOP, NOP / 7--OPR NOP / 6--IOT;"NOP" OR "JMP XWOR5" JMS ABKLOC /DID MATCH, OUTPUT LOC JMS I GETI /GET THAT WORD ERC06, ERROR / OH I HOPE NOT!!! JMS I OCTI /AND OUTPUT IT IN OCTAL JMS I CRLFI XWOR5, JMS LCHEK /DONE YET? JMP XWOR4 /NO /SUBROUTINE TO INITIALIZE THE SEARCH COMMANDS SSET, 0 DCA ABSSW /RESET ABSOLUTE SWITCH TAD LBLK /SET UP START BLK & LOC DCA BLK TAD LLOCH DCA LOCH TAD LLOCL DCA LOCL TAD UBLK /SET UP END BLK & LOC DCA EBLK TAD ULOCH DCA ELOCH TAD ULOCL DCA ELOCL JMP I SSET /COMMON OPTIONS FOR 'WORD' AND 'STRING' SEARCHES XWSABS, STA DCA ABSSW /'ABSOLUTE'--SET SWITCH JMP XWSRET / XWSFRM, JMS I LIMITI /'FROM'--GET LOWER LIMITS BLK JMP XWSRET / XWSTO, TAD UBLK /'TO'--SET UP IF NEEDED DCA EBLK JMS I LIMITI / & GET UPPER LIMITS EBLK XWSRET, STA CLL RAL /= -2, CALCULATE RETURN ADDRESS AS TAD I GWORDI / LAST CALL TO "GWORD" TO ALLOW DCA LCHEK / THESE TO BE COMMON TO BOTH JMP I LCHEK / 'WORD' AND 'STRING' SEARCHES. EBLK, 0 ELOCH, 0 ELOCL, 0 LSETUP, 0 /SET SEARCH WORD-COUNTERS **** SEE NOTE **** DCA ACC1 /INITIALIZE THESE TO 0 DCA ACC2 TAD MODSW /IN A MAPPED MODE? SMA SZA CLA JMP LSETL / YES, IGNORE BLOCK PARTS TAD BLK / NO, SET UP FOR 24 BIT DCA ACC1 TAD EBLK / BLK-EBLK DCA OPER1 DCA OPER2 JMS DSUB /DO THE SUBTRACTION TAD (400 /NOW SET UP MULTIPLY BY 400 DCA OPER1 DCA OPER2 JMS DMUL /GIVES: (BLK-EBLK)*400 LSETL, CLL IAC TAD ELOCL DCA OPER1 /NOW SET UP ELOC+1 RAL TAD ELOCH DCA OPER2 JMS DSUB /AND SUBTRACT IT TAD LOCL /NOW ADD LOC TO GIVE: DCA OPER1 / (BLK-EBLK)*400+(LOC-ELOC-1) TAD LOCH / WHICH IS 24-BIT COUNT OF DCA OPER2 / WORDS TO SEARCH. JMS DADD TAD ACC2 /IF NOT NEGATIVE, ALREADY TOO SMA CLA JMP I RECRLF / FAR, SO JUST QUIT NOW! JMP I LSETUP /**** NOTE: COUNT LEFT SET UP IN ACC1 & ACC2 **** LCHEK, 0 /CHECK IF SEARCH RANGE EXHAUSTED JMS I INCI /INCREMENT LOC ISZ ACC1 /COUNT WORDS TO DO JMP I LCHEK ISZ ACC2 / (24-BIT) JMP I LCHEK JMP I RECRLF /DO CR/LF & STOP! TIDPNT, 0 /"TAD I DPNT" IN FIELD 1 CDF 10 TAD I DPNT CDF 0 JMP I TIDPNT PAGE /ROUTINE TO 'REWIND' THE DEVICE XREWIN, CDF 10 TAD USRAD /RESET DIRECTORY SEGMENT KEY SMA CLA DCA I N7 / IN USR IF IT IS IN MEMORY. CDF 0 JMS I DEVAD /CALL HANDLER 0110 /READ, 1 PAGE, FIELD 1 PDLB /DUMMY BUFFER (ZAP P.D.L.) 1 /BLK 1 JMP RERROR /READ ERROR! JMP I RESTAR /READ ERROR--TEST TYPE & OUTPUT MESSAGE RERROR, SPA CLA /BIT 0 = 1 IF FATAL ERC00, ERROR /FATAL ERC01, ERROR /NON-FATAL /ROUTINE TO EXECUTE THE 'STRING' SEARCH COMMAND XSTRIN, JMS SSET /INITIALIZE TAD (STJMP-STCDF /RESET MASKING SWITCH XSTR0, TAD XREWIN / OR SET MASKING SWITCH DCA SMSKSW JMS I GWORDI /GET POSSIBLE WORD JMP XSTR1 /NUMBERS ONLY ISZ CRSWT /FOLLOWED BY A CR? JMP ERCI / YES, KICK OUT***** JMS I SORTI /LOOK UP OPTION: MA, SEALST-1 / AB, FR, TO STROPS-SEALST JMP ERCH /NO LIKEE! / XSTR1, JMS I GARGI /GET ARGS - THEN REPACK INTO BUFFER TAD TEMP / MASKING THEM IF SPECIFIED DCA CNTR /SET UP LENGTH TAD TEMPST DCA SCANX2 /STORING DONE IN NEG. FORM JMP XSTR2+2 /GO SET UP MASK / XSTR2, ISZ TEMP3 /MASK END? JMP XSTR3 TAD MASKBS /YES, RESET MASK DCA SPNT TAD SMASKL /SET UP LENGTH DCA TEMP3 XSTR3, ISZ DPNT /SKIP 2 EXTRA WORDS ISZ DPNT TAD I DPNT /GET A WORD JMS STRMSK /TEST & MASK CIA /NEGATE DCA I SCANX2 /STORE ISZ DPNT /BUMP POINTER ISZ CNTR /DONE? JMP XSTR2 JMS LSETUP /YES, SET UP COUNT OF WORDS XSTR4, TAD TEMPST /SET UP FOR SEARCH: DCA DPNT / STRING, TAD TEMP DCA CNTR / & STRING LENGTH. TAD LOCL DCA XLOCL /SAVE CURRENT LOCATION TAD LOCH DCA XLOCH TAD BLK DCA XBLK TAD ACC1 / & COUNT FOR RESET DCA OPER1 TAD ACC2 DCA OPER2 JMP XSTR6 /NOW SET UP MASK / XSTR5, JMS LCHEK /DONE? ISZ TEMP3 /NO, AT MASK END? JMP XSTR7 XSTR6, TAD MASKBS / YES, RESET MASK DCA SPNT TAD SMASKL DCA TEMP3 XSTR7, JMS I GETI /GET NEXT WORD JMP XSTR10 /MAPPED MODE, NO SUCH ADDRESS JMS STRMSK /TEST & MASK TAD I DPNT /COMPARE? SZA CLA JMP XSTR10 /NO, GO RESET & CONTINUE ISZ CNTR /MATCHED ENOUGH? JMP XSTR5 /NOT YET JMS XRSET /YES, RESET LOCATION & COUNT TAD TEMP /AND LENGTH DCA CNTR XSTR8, TAD M10 DCA ACCX1 / -(#/LINE) JMS ABKLOC /OUTPUT THIS LOCATION XSTR9, JMS I GETI /GET A WORD JMP ERC06 /BAD,BAD,BAD!!! JMS I OCTI /AND OUTPUT IN OCTAL JMS I INCI /INCREMENT LOC ISZ CNTR /DONE? JMP XSTR11 /NO, CONTINUE JMS I CRLFI /YES, OUTPUT CR/LF XSTR10, JMS XRSET /RESET LOCATION & COUNT JMS LCHEK /DONE? JMP XSTR4 /NO, LOC INC'D, TRY NEXT / XSTR11, SPACE2 /OUTPUT " " ISZ ACCX1 /DONE ON THIS LINE? JMP XSTR9 /NO, NOT YET JMS I CRLFI /YES JMP XSTR8 XRSET, 0 /RESET BLK & LOC FROM XBLK & XLOC TAD XLOCL /LOC DCA LOCL TAD XLOCH DCA LOCH TAD XBLK /BLK DCA BLK TAD OPER1 /WORDS LEFT TO SEARCH DCA ACC1 TAD OPER2 DCA ACC2 JMP I XRSET STRMSK, 0 /STRING MASKING *** NEXT WORD MODIFIED *** SMSKSW, CDF 10 /"CDF 10" OR "JMP I STRMSK" AND I SPNT /OK, MASK IN FIELD 1 CDF 0 JMP I STRMSK STJMP= JMP I STRMSK STCDF= CDF 10 XBLK, 0 XLOCH, 0 XLOCL, 0 PAGE /ROUTINE TO EXECUTE THE BLOCK 'WRITE' COMMAND XWRARG, JMS I ARGI /GET ONE ARG TAD ACC1 /USE IT AS THE BLOCK SKP XWRITE, TAD WBLK /SET BLOCK DCA XWBLK JMS I DEVAD /CALL HANDLER 4210 /WRITE, 2 PAGES, FIELD 1 IOBUF XWBLK, 0 /[** COUNTER FOR MODIFY **] JMP WERROR /WRITE ERROR DCA MODIF /CLEAR SOMETHING-CHANGED FLAG JMP I RESTAR /WRITE ERROR--TEST TYPE & OUTPUT MESSAGE WERROR, SPA CLA /BIT 0 = 1 IF FATAL ERC02, ERROR /FATAL ERC03, ERROR /NON-FATAL /ROUTINE TO EXECUTE THE 'MODIFY' COMMAND XMODIF, JMS I GWORDI /GET FORMAT WORD IF ONE JMP XMOD4 /NONE, GET DEFAULT DCA MODTMP /SAVE FOR LATER ISZ CRSWT /TERMINATED BY A CR? JMP ERCO / YES, SAVE USER FROM HIMSELF! TAD MODTMP /TEST FORMAT FOR RECOGNITION JMS I SORTI MODIFL-1 MODADS-MODIFL ERCO, ERROR / I THEENK YOU USE BAD WORD! / XMOD0, JMS I GARGI /OK, NOW GET ARGS TAD TEMP /MOVE COUNT TO A SAFE PLACE DCA XWBLK XMOD1, TAD I DPNT /GET BLOCK # JMS BLKTST /TEST & SET BLK TAD I DPNT /GET LOC DCA LOCH TAD I DPNT DCA LOCL TAD I DPNT /GET -(# LOCS) DCA CNTR XMOD2, TAD COMST /INIT COMM. BUFF. FOR MODS DCA COMIR DCA CHARSW /RESET HALF SWITCH JMS I SOCTI /INITIALIZE INPUT TO OCTAL JMS I BKLOCI /OUTPUT START LOC BLK-1 JMS I TWOCI /AND ": " 7240 XMOD3, READCH /GET A CHAR (TEST: RUBOUT, ^U & ^R) JMP XMOD2 /BUFFER EMPTIED! JMS I SORTI /CHECK FOR SPECIALS TYPEM-1 /IGNORE LF'S MCHARO-TYPEM TAD CHAR /OK, SAVE IT CDF 10 DCA I COMIR CDF 0 JMP XMOD3 /CONTINUE / /NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT XMOD4, TAD FCNT /USE CURRENT FORMAT, TAD (MODDLS-1 / WITH A LITTLE DIFFERENCE DCA DPNT TADIDP /GET THE ONE TO USE DCA MODTMP / AND SAVE IT JMP XMOD0 /NOW GET ARGS / / /CR TYPED, END XMOD6, JMS I ENDCI /END BUFFER WITH A CR. JMP XMOD2 /ONLY A CR IN BUFFER-RETRY! TAD MODTMP /NOW LOOK UP FORMAT JMS I SORTI MODIFL-1 MODIFO-MODIFL ERCP, ERROR /ILLEGAL (EXTRA BAD IF HERE) XMOD7, ISZ XWBLK /RETURN HERE, ALL ARGS DONE? JMP XMOD1 /NO JMP I RESTAR /YES MODTMP, 0 XGET, 0 /SUB. TO SET CURRENT LOC & FLAG JMS I GETI /SET LOCATION ERC07, ERROR /MAPPED MODE, NO SUCH ADDRESS STA DCA MODIF /SET FLAG JMP I XGET /NUMERIC FORMATS HERE XNUM0, JMS I SORTI /TEST TERMINATOR ARGLST-2 /SPACE, COMMA, CR NUMOPS-ARGLST+1 JMP ERCQ /ILLEGAL TERMIN / XNUM1, JMS I GETNI /COMMA, SKIP IT JMS I SSKIPI / SPACE, IGNORE IT XNUM2, JMS EXPRIN /GET NEXT ARG--EXPRESSION JMS XGET /SET UP LOCATION TAD ACC1 DCAICAD / & STORE VALUE JMS I INCI /INCREMENT LOCATION ISZ CNTR /ALL MODS DONE? JMP XNUM0 /NO, TEST TERMIN JMP XMOD7 /YES, TEST NEXT SET / XNUM3, TAD CNTR /DONE? SNA CLA JMP XMOD7 /YES JMS XGET /NO, SET UP LOC TAD FILLER DCAICAD /AND FILL WITH 'FILLER' JMS I INCI /INCREMENT LOC ISZ CNTR /DONE? JMP XNUM3 /NO JMP XMOD7 /YES /ASCII FORMAT HERE JMS CGET /GET A CHAR & CHECK FOR CR XASC1, JMS XGET /SET UP LOC & SET FLAG TAD CHAR DCAICAD /STORE THIS CHAR JMS I INCI /INCREMENT LOC ISZ CNTR /MODS DONE? JMP XASC1-1 /NO JMP XMOD7 /YES CGET, 0 /GET NEXT CHAR. IF CR, MODS DONE JMS CGTEST /GET & TEST NEXT JMP XNUM3 /CR, FILL REST WITH 'FILLER' JMP I CGET CGTEST, 0 /SUB. TO GET A CHAR & CHECK FOR CR JMS I GETNI /GET NEXT CHARACTER TAD CHAR /IS IT A CR? TAD M215 SZA CLA ISZ CGTEST /RETURN TO CALL+2 IF NOT JMP I CGTEST PAGE /ROUTINE TO EXECUTE THE 'SMASK' (STRING MASK) COMMAND XSMASK, JMS I GARGI /GET ARGS TAD TEMP DCA SMASKL /SAVE -(MASK LENGTH) TAD MASKBS /SET UP TO STORE WORDS DCA SPNT XSMAS1, ISZ DPNT /SKIP 2 WORDS ISZ DPNT TAD I DPNT /GET & STORE ONE CDF 10 DCA I SPNT CDF 0 ISZ DPNT /SKIP 1 MORE ISZ TEMP /DONE ? JMP XSMAS1 /NO JMP I RESTAR /COS PACKED ASCII FORMAT HERE XCOS0, TAD M240 /SET OFFSET /PACKED ASCII FORMAT HERE XPAC0, DCA PNAME /CLEAR OFFSET XPAC1, TAD M240 /IS CHAR < 240? TAD CHAR SMA CLA JMP XPAC2 /NO, JUST PACK CHAR CMA JMS PACK /YES, PACK A FLAG (77) FIRST XPAC2, TAD CHAR /NOW GO PACK CHAR TAD PNAME /(WITH DESIRED OFFSET) JMS PACK JMS I CGETI /NOW GET & TEST NEXT JMP XPAC1 / OK, CONTINUE /OS/8 ASCII HERE XOPS1, TAD LOCL /TEST START & COUNT FOR EVEN RAR /(LOW BIT TO LINK & CLA / CLEAR AC) TAD CNTR RAR /(LOW TO LINK, LINK TO AC0) SZL SPA CLA /BOTH L=0 & AC0=0 FOR OK ERC04, ERROR /START OR COUNT NOT EVEN XOPS2, TAD CHARSW /GET SWITCH ISZ CHARSW / & BUMP IT CLL RAR /ROTATE AC 11 INTO LINK SZL SNA CLA /CHARACTER 3? JMP XOPS5 /NO, CHAR 1 OR CHAR 2 STA TAD CAD /YES, BACK UP POINTER DCA CAD STA CLL RAL / & SET LOOP COUNT TO -2 DCA CHARSW XOPS3, TAD CHAR /GET REST OF CHAR CLL RTL /4 BITS LEFT RTL DCA CHAR /SAVE IT TAD CHAR /NOW MERGE 4 BITS WITH AND N7400 / A PREVIOUS CHAR TADICAD DCAICAD /4 BITS OF 3RD + 1ST OR 2ND ISZ CAD /BUMP POINTER ISZ CHARSW /DONE? JMP XOPS3 TAD CNTR /YES, DONE ALL MODS? SNA CLA JMP I XMOD7I /YES, TEST FOR DONE XOPS4, JMS I CGETI /GET & TEST NEXT CHAR JMP XOPS2 /OK, DO NEXT / XOPS5, JMS I XGETI /SET UP CURRENT LOC TAD CHAR DCAICAD /AND STORE CHARACTER JMS I INCI /INCREMENT LOC ISZ CNTR /BUMP COUNTER FOR LATER JMP XOPS4 / SO IGNORE SKIP NOW JMP XOPS4 PACK, 0 /SUB. TO PACK CHARACTERS AND N77 /USE ONLY 6 BITS ISZ CHARSW /CHECK HALF JMP PACK1 TADICAD /RIGHT HALF, ADD TO LEFT DCAICAD TAD CNTR /ALL MODS DONE? SZA CLA JMP I PACK /NO JMP I XMOD7I /YES / PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT DCA CHARSW /SAVE IT JMS I XGETI /SET UP CURRENT LOC TAD CHARSW DCAICAD /STORE WORD JMS I INCI /INCREMENT LOC ISZ CNTR /BUMP COUNTER FOR LATER NOP / SO DON'T SKIP NOW STA DCA CHARSW /RESET SWITCH JMP I PACK XGETI, XGET CGETI, CGET XMOD7I, XMOD7 PNAME, 0 /PRINT A FILE NAME, PADDED W. SPACES TAD NAM1 JMS I TWOT / OUTPUT UP TO TAD NAM2 JMS I TWOT / 6 CHARACTERS TAD NAM3 JMS I TWOT / OF FILE NAME, JMS I TYPECI / A "." ". TAD NAM4 / & UP TO 2 CHARS JMS I TWOT / OF EXTENSION. PNAME1, SPACE1 /OUTPUT A " " TAD NCNT /11(10) CHARS ON LINE YET? TAD (-13 SPA CLA JMP PNAME1 /NO, OUTPUT ANOTHER SPACE JMP I PNAME RTL6, 0 /ROTATE AC 6 LEFT CLL RTL RTL RTL JMP I RTL6 RTR6, 0 /ROTATE AC 6 RIGHT CLL RTR RTR RTR JMP I RTR6 PAGE /SUBROUTINE TO 'GET' A WORD FROM THE DEVICE. / / THE ACTUAL WORD ON THE DEVICE THAT IS ACCESSED / IS DEPENDENT ON THE MODE SWITCH, AS FOLLOWS: / / MODE ACTION / / 0 = NORMAL THE HIGH 7 BITS OF THE 15 BIT ADDRESS / ARE ADDED TO THE SPECIFIED BLOCK # / TO GET THE ACTUAL BLOCK & THE LOW 8 / BITS OF THE 15 BIT ADDR ARE USED TO / SPECIFY THE WORD WITHIN THE BLOCK. / / -1 = OFFSET THE 12 BIT "OFFSET" (WHICH IS NEGATED) / IS ADDED TO THE LOW 12 BITS OF THE / ADDRESS, AND THEN THE NEW ADDRESS IS / HANDLED AS ABOVE. / THIS MODE IS USED PRIMARILY WHEN / WORKING WITH THE OPERATING SYSTEM / WITH OVERLAYS WHOSE REAL START BLOCK / AND LOCATION WITHIN A FIELD ARE KNOWN. / BY SETTING THE "OFFSET" TO THE START / ADDRESS OF THE OVERLAY, ITS REAL / ADDRESSES CAN BE USED AND THE PROPER / LOCATIONS WILL BE ACCESSED. / / +1 = SAVE THIS MODE IS USED WITH CORE IMAGE / "SAVE" FILES ONLY. THE FILE'S CCB / (CORE CONTROL BLOCK) IS USED TO / DETERMINE THE REAL LOCATION ON THE / DEVICE OF THE SPECIFIED 15 BIT ADDR- / ESS. THE START BLOCK OF THE FILE / IS USED, AND ANY SPECIFIED "BLOCK" / PART IS USED TO SPECIFY THE OVERLAY / WANTED AT THAT ADDRESS. FOR FILES / WITHOUT OVERLAYS (GENERATED BY THE / MONITOR "SAVE" COMMAND), THIS PART / MUST BE ZERO (0) OR NO MATCH WILL / OCCUR. FOR FILES WITH OVERLAYS / (GENERATED BY THE PROGRAM "LINK"), / A LEGAL OVERLAY AT THE SPECIFIED / ADDRESS MUST BE SPECIFIED FOR A / MATCH TO OCCUR. THIS MODE CAN ONLY / BE USED AFTER A "FILE" COMMAND. / / +2 = LOAD THIS MODE IS USED WITH OS/8 FORTRAN / IV LOAD MODULES. THE FILE'S HEADER / BLOCK IS USED TO DETERMINE THE REAL / LOCATION ON THE DEVICE OF THE SPECI- / FIED 15 BIT ADDRESS AND THE "BLOCK" / PART IS USED TO SPECIFY THE OVERLAY / WANTED AT THAT ADDRESS. THIS MODE CAN / ONLY BE USED AFTER A "FILE" COMMAND. /CALLING SEQUENCE: / / JMS I GETI / RETURN1 /MODE=MAPPED, NO SUCH ADDRESS / NORMAL RETURN /'CAD' SET, DATA IN AC /SUBROUTINE 'GET'--PART OF THIS PAGE & ALL OF NEXT GET, 0 JMS I CTRLI /GO TEST FOR CONTROL-CHARS TAD MODSW /OK, TEST MODE SNA JMP GET0 /NORMAL MODE, NO CHANGES SMA CLA JMP GET4 /SAVE MODE, DO MAPPING TAD OFFSET /OFFSET MODE, ADD IT GET0, JMS DBLPGS /NOW ADD 'DOUBLE PAGES' TAD BLK / OF LOC TO BLK TO SET DCA CBLK /'CURRENT BLOCK' GET1, JMS GETIO /OUTPUT CURREN (IF NEEDED), GET NEXT JMP RERROR / READ ERROR, GO TELL ABOUT IT TAD MODSW /TEST AGAIN FOR OFFSET SPA CLA TAD OFFSET /YES, ADD IT AGAIN TAD LOCL /USE 8 ADDRESS BITS FROM LOC AND N377 TAD BUFST /INTO BUFFER, TO SET DCA CAD /'CURRENT ADDRESS' TADICAD /NOW GET THE WORD ISZ GET /RETURN TO CALL+2 WITH IT GETX, JMP I GET /[EXIT TO CALL+1 FOR MAP FAIL] GETIO, 0 /DO I/O FOR 'GET' & 'SCANER' TAD CBLK /IS THIS SAME BLOCK AS IS IN CIA /CORE CURRENTLY? TAD RBLK SNA CLA JMP GETIO2 /YES, USE IT. ISZ MODIF /NO, ANY CHANGES IN THIS BLK? JMP GETIO1 /NO, DEVICE OK AS IS JMS I DEVAD /CALL DEVICE HANDLER 4210 /WRITE, 2 PAGES, FIELD 1 BUFST, IOBUF WBLK, 0 JMP WERROR /WRITE ERROR GETIO1, TAD CBLK /NOW UPDATE OUTPUT BLOCK DCA WBLK TAD CBLK / AND INPUT BLOCK # MQL /(2 NOP'S IF NO MQ!) MQA DCA RBLK DCA MODIF / AND RESET SWITCH JMS I DEVAD /CALL DEVICE HANDLER 0210 /READ, 2 PAGES, FIELD 1 IOBUF RBLK, -1 /(NOTHING IN CORE-ILLEGAL BLK #) JMP I GETIO /READ ERROR GETIO2, ISZ GETIO /OK, DO NORMAL RETURN JMP I GETIO DBLPGS, 0 /CONVERT LOCATION TO DOUBLE-PAGES TAD LOCL AND M400 /HIGH 4 BITS HERE CLL RAL /BECOME LOW 4 BITS TAD LOCH /FOR A 7 BIT VALUE RTL RTL JMP I DBLPGS /GET WORD ROUTINE FOR "ODT" COMMANDS ODGET, 0 TAD SBLK /SET UP BLOCK DCA BLK TAD SLOCH DCA LOCH TAD SLOCL DCA LOCL /SET UP LOCATION JMS I GETI /NOW GET WORD ERC05, ERROR /MAPPED MODE, NO SUCH ADDRESS JMP I ODGET / & RETURN WITH IT /OUTPUT 12 BIT BLOCK # & 15 BIT ADDRESS IN OCTAL BKLOC, 0 TAD I BKLOC /GET ARGUMENT (ADDR-1) ISZ BKLOC DCA GETPNT / & SET UP A-XR TAD I GETPNT /GET BLOCK PART JMS I OCTI / & OUTPUT IT TAD I GETPNT /GET FIELD AND N7 JMS I TWOCI / & OUTPUT "." & IT 5660 / (".0") TAD I GETPNT /GET ADDRESS JMS I OCTI / & OUTPUT IT JMP I BKLOC /SUBROUTINE TO GET A COMMAND WORD OR CHARACTER /FROM THE COMMAND BUFFER. IF THE BUFFER CONTAINS /ONLY NUMERIC ITEMS, RETURN TO CALL+1. TERMINATOR /IS SPACE OR CR GWORD, 0 JMS I SSKIPI /GET NEXT NON-SPACE TAD CHAR AND N77 /USE THIS CHAR AS LEFT JMS I RTL6I / 6 BITS. DCA CHARSW /SAVE IT JMS I SORTI /CHECK FOR ^K, ^D, (, ", ', GWLST1-1 / DIGITS, SPACE & CR GWOPS1-GWLST1 JMS I GETNI /NONE, IS NEXT A SPACE JMS I SORTI / OR A C.R.? GWLST2-1 GWOPS2-GWLST2 TAD CHAR /NONE, USE AS LOWER 6 BITS AND N77 TAD CHARSW DCA CHARSW /SAVE IT GWD1, JMS I GETNI /LOOK FOR SPACE OR C.R. JMS I SORTI GWLST2-1 GWOPS2-GWLST2 JMP GWD1 /NEITHER, KEEP LOOKING / GWD2, STA /SPACE FOUND, SET SWITCH GWD3, DCA CRSWT /CR FOUND, RESET SWITCH TAD CHARSW /RETURN WITH WORD ISZ GWORD / TO CALL+2 GWD4, JMP I GWORD /EXIT TO CALL+1 IF ANY NUMERIC ITEM FOUND-- / ^K, ^D, (, ", ', DIGITS /"DIRECTORY" FORMAT OUTPUT ROUTINE DIRDMP, 0 JMS I OCTI /OUTPUT IN OCTAL FIRST SPACE2 TADICAD JMS DIROUT / THEN 3 OTHERS JMP I DIRDMP /"?" ODT OUTPUT ROUTINE DIROUT, 0 CIA /ASSUME WAS NEGATIVE JMS I DECI / & OUTPUT IN DECIMAL SPACE2 TADICAD JMS PDATE /OUTPUT AGAIN AS DATE SPACE2 TADICAD JMS I TWOT /OUTPUT LAST TIME AS PACKED ASCII JMP I DIROUT PAGE /CONTINUATION OF 'GET' -- MAPPING FOR "SAVE" AND "LOAD" / MODES DONE HERE. GET4, JMS DBLPGS /GET # DOUBLE-PAGES DCA CAD / & SAVE IT STA TAD MODSW /TEST FOR SAVE OR LOAD MODE SZA CLA JMP GETL1 / LOAD MODE CDF CIF 10 JMS GCCB /SAVE MODE, GET CCB DCA SEGCNT / & SET UP # SEGMENTS TAD RBLK1 /SET UP ACTUAL FIRST BLOCK IAC DCA CBLK / FOR MAPPING. GETS1, CDF 10 TAD I GETPNT /GET AN ORIGIN WORD DCA GETORG TAD I GETPNT / & A CONTROL WORD. CDF 0 DCA GETCW TAD GETCW /TEST FOR FIELD MATCH CLL RTR RAR AND N7 /(MASK OFF COUNT) CIA TAD LOCH /SAME? SZA CLA JMP GETS2 /NO, TRY NEXT SEGMENT TAD LOCL /YES, NOW TEST ADDRESSES AND M200 /(MASK TO PAGE) STL CIA TAD GETORG /[ORIG PAGE]-[ADDR PAGE] SZA SNL /ABOVE THE ORIGIN? JMP GETS2 /NO, TRY NEXT RAR /OK, DIVIDE BY 2 (WITH SIGN) DCA GETORG / & SAVE IT. TAD GETCW /BEYOND TOP OF SEGMENT? AND M100 /(MASK OFF FIELD AND MAKE) SNA STL RAR / 0 => 40, THEN SUBTRACT TAD M100 / ONE PAGE) TAD GETORG SPA CLA JMP GETS2 /NO, TRY NEXT TAD GETORG /YES, UPDATE CBLK TO RIGHT CIA JMS UPCBLK / ACTUAL BLOCK TAD BLK /MUST BE IN "LVL 0" OR SZA CLA JMP GETX / RETURN AS BAD JMP GET1 /NOW GO GET THE DATA / GETS2, CLA TAD GETCW /UPDATE CBLK AND M100 SNA STL RAR /(MAKING 0 => 40) TAD (100 /(ROUND UP PAGE COUNT) JMS UPCBLK ISZ SEGCNT /ALL SEGMENTS DONE? JMP GETS1 /NO, TRY NEXT TAD OVLFLG /YES, OVERLAYS? (LINK OUTPUT) SNA JMP GETX / NO, RETURN TO CALL+1 DCA GETPNT / YES, RESET POINTER JMP GETL2 / & CONTINUE / GETL1, CDF CIF 10 JMS GHDR /GET & TEST HEADER GETL2, CDF 10 TAD I GETPNT /GET NUMBER OF OVERLAYS DCA SEGCNT TAD I GETPNT /GET PAGE & FIELD DCA GETCW TAD I GETPNT /GET REL BLK NUMBER TAD RBLK1 / + START BLOCK DCA CBLK / = ABS START BLK, THIS LEVEL TAD I GETPNT /GET LENGTH, THESE OVERLAYS CDF 0 DCA GETORG TAD GETCW /GET DBL-PAGE & FIELD SNA JMP GETX / 0 = THE END!!! AND M400 /CONVERT TO DBL-PAGE # CLL RTL RTL TAD GETCW / IN BITS 5-11 RAL AND N177 CIA /-(DBL-PG # OF OVLY START) TAD CAD /+(DBL-PG # OF DESIRED) SPA JMP GETL3 / GONE TOO FAR, MISSED IT! DCA GETCW /= RELATIVE BLOCK NUMBER TAD GETCW /IS THIS WITHIN THIS OVLY? CIA TAD GETORG SPA SNA CLA JMP GETL2 / NO, TRY NEXT OVERLAY TAD BLK /OK, SET UP -(#LVL +1) CMA DCA GETORG TAD GETORG /ADDR IS OK, IS THERE A TAD SEGCNT / LEVEL WANTED? GETL3, SPA CLA JMP GETX /ILLEGAL LEVEL; TOO FAR--EXIT TAD GETCW /ALL OK! ADD RELATIVE BLK SKP GETL4, TAD SEGCNT / TO (LVLS-1)*LENGTH TAD CBLK DCA CBLK / TO OVERLAY START BLOCK ISZ GETORG /[MULTIPLY BY ADDING] JMP GETL4 JMP GET1 GETORG, 0 GETCW, 0 SEGCNT, 0 UPCBLK, 0 JMS I RTR6I /MOVE COUNT TO BITS 6-11 CLL RAR /DIVIDE FOR DOUBLE PAGES TAD CBLK /UPDATE DCA CBLK JMP I UPCBLK PAGE /NUMERIC OUTPUT SUBROUTINES, NO ZERO SUPPRESSION: OPRT, 0 /4-DIGIT OCTAL JMS NUMOUT -1000 -100 -10 0 JMP I OPRT OCT3, 0 /3-DIGIT OCTAL JMS NUMOUT -100 -10 0 JMP I OCT3 BPRT, 0 /3-DIGIT BCD JMS NUMOUT -400 -20 0 JMP I BPRT SGNDP, 0 /4-DIGIT DECIMAL, SIGNED DCA NUMB TAD NUMB SPA CLA TAD N15 SPACE1 /OUTPUT "-" OR " " TAD NUMB /NOW OUTPUT IN DECIMAL SPA CIA JMS DPRT JMP I SGNDP DECIMAL DPRT, 0 /4-DIGIT DECIMAL, UNSIGNED JMS NUMOUT -1000 -100 -10 0 JMP I DPRT DEC2, 0 /2-DIGIT DECIMAL, UNSIGNED AND N177 /MASK IT FIRST JMS NUMOUT -10 0 JMP I DEC2 OCTAL NUMOUT, 0 /THE REAL OUTPUT SUBROUTINE DCA NUMB /SAVE THE NUMBER NUMO1, DCA NUMDGT /RESET "DIGIT" TO 0 CLA CLL TAD NUMB /GET CURRENT VALUE TAD I NUMOUT /SUBTRACT DIGIT BASE SNL /DID IT OVERFLOW? JMP NUMO2 /NO, TOO FAR! ISZ NUMDGT /YES, BUMP DIGIT DCA NUMB / & UPDATE VALUE JMP NUMO1+1 / NUMO2, CLA CLL TAD NUMDGT /OUTPUT THE "DIGIT" DIGIT ISZ NUMOUT /BUMP TO NEXT ARG TAD I NUMOUT /DONE ENOUGH? SZA CLA JMP NUMO1 TAD NUMB /YES, SO OUTPUT THE LAST DIGIT / ONE. JMP I NUMOUT /AND RETURN NUMB, 0 NUMDGT, 0 SSKIP, 0 /SKIP SPACES IN COMMAND BUFFER. TAD CHAR TAD M240 /IS THIS A SPACE? SZA CLA JMP I SSKIP /NO, DONE JMS I GETNI /YES, GET NEXT CHAR JMP SSKIP+1 / & GO TRY IT /OS/8 ASCII OUTPUT SUBROUTINE. OUTPUTS 1 CHAR / FOR EVEN WORD & 2 CHARS FOR ODD WORD. OSTYPE, 0 JMS OSSET /DO SETUP FOR UNPACKING AND N177 /MAKE CHARS INTO "STANDARD" TAD N200 / FORM: 7 BITS + PARITY ON JMS I TYPEI / & OUTPUT CHAR ISZ CHARSW /UNPACK 2ND CHARACTER? JMP OSUNPK / YES, & RETURN TO OSSET CALL! JMP I OSTYPE /DONE, RETURN TO CALLER /OS/8 "BYTE" OUTPUT SUBROUTINE. OUTPUT ONE / 8-BIT OCTAL NUMBER FOR EVEN WORD AND TWO 8- / BIT OCTAL NUMBERS FOR ODD WORD. USED FOR / DUMPING OS/8 ".BN" FILES OR ASCII IN OCTAL. BYTEO, 0 JMS OSSET /DO SETUP FOR UNPACKING JMS OCT3 /3 DIGIT OCTAL OUTPUT ISZ CHARSW /UNPACK 2ND "CHAR"? SKP JMP I BYTEO / DONE, RETURN SPACE2 /YES, BUT OUTPUT 2 SPACES JMP OSUNPK / BEFORE DOING UNPACKING /OS/8 FORMAT UNPACKING ROUTINES FOR 'OSTYPE' AND / 'BYTEO'. THE SUBROUTINE SETS UP THE COUNTER / FOR NUMBER OF OUTPUTS TO DO, SAVING & RESTORING / THE AC. THE ROUTINE WILL BE CALLED ONLY IF 2 / OUTPUTS BEING DONE AND DOES THE UNPACK OF THE / 2ND "CHARACTER", RETURNING TO THE CALLER OF THE / SUBROUTINE! OSSET, 0 DCA INC /SAVE AC IAC AND LOCL /AC = 0 OR 1 CMA /AC = -1 OR -2 (-# TO DO) DCA CHARSW /SET UP UNPACK COUNT OSRETN, TAD INC /GET VALUE TO AC AND N377 /MASK TO 8 BITS JMP I OSSET / OSUNPK, STA TAD CAD DCA SGNDP /POINT TO HIGH WORD CDF 10 TAD I CAD /GET LOW BITS OF "CHAR" AND N7400 / MASK TO 4 BITS AND JMS I RTR6I / MOVE TO BITS 8-11 RTR DCA INC /SAVING IT HERE FOR LATER! TAD I SGNDP /NOW GET HIGH BITS OF "CHAR" AND N7400 / MASK TO 4 BITS AND CDF 0 CLL RTR / MOVE TO BITS 4-7 RTR JMP OSRETN /GET OTHER BITS & RETURN! /SUBROUTINE TO INCREMENT THE "CURRENT LOCATION" INC, 0 ISZ LOCL /INCREMENT LOW 12 ADDR BITS JMP I INC /OK AS IS CLL TAD LOCH /LOW OVERFLOW, INCR. HIGH TAD (7771 / 3 ADDRESS BITS (& TEST) AND N7 DCA LOCH SZL /DID HIGH OVERFLOW ALSO? TAD N200 / YES, THEN BUMP BLK ALSO TAD BLK DCA BLK JMP I INC PAGE /OUTPUT PACKED STRING, ADDRESS IN CALL+1, / TERMINATOR IS XX00. TYPES, 0 TAD I TYPES ISZ TYPES JMS TYPSTR JMP I TYPES /OUTPUT PACKED STRING, ADDRESS IN AC, TERMIN IS XX00 TYPSTR, 0 DCA GETNT TTAGN, CDF 10 TAD I GETNT CDF 0 ISZ GETNT JMS PACOUT TAD GNAME AND N77 SNA CLA JMP I TYPSTR JMP TTAGN /PACKED ASCII OUTPUT ROUTINE PACOUT, 0 DCA GNAME TAD GNAME /USE LEFT 6 BITS JMS I RTR6I JMS ONECHR TAD GNAME /USE RIGHT 6 BITS JMS ONECHR JMP I PACOUT /OUTPUT TRIMMED OR UNTRIMMED ASCII IN THE AC ONECHR, 0 /NO CODE FOR CR/LF AND N77 SNA JMP I ONECHR /IGNORE "@" TAD (-40 SMA TAD M100 JMS I TYPECI 340 JMP I ONECHR /SUBROUTINE TO MATCH CHAR AGAINST LIST1 AND JUMP /THROUGH LIST2 WHEN MATCH FOUND. BOTH LISTS IN /FIELD 1. SORTJ, 0 SNA TAD CHAR /USE CHAR IF AC = 0 DCA SORTEM /ITEM TO LOOK UP TAD I SORTJ ISZ SORTJ /GET LIST1 ADDRESS DCA SCANX1 SORT1, CDF 10 TAD I SCANX1 /COMPARE WITH SORTEM CDF 0 SNA /0 ? JMP SORT2 /END OF LIST CIA STL TAD SORTEM SZA CLA /DOES IT MATCH? JMP SORT1 /NO, TRY NEXT TAD SCANX1 /YES, GET ADDRESS... TAD I SORTJ DCA SORTJ /...OF JUMP ADDRESS CDF 10 TAD I SORTJ DCA SORTJ CDF 0 JMP I SORTJ /GO TO ROUTINE SORT2, ISZ SORTJ /MATCH NOT FOUND, JMP I SORTJ /EXIT TO CALL+3 SORTEM, 0 /SUBROUTINE TO GET A NAME FOR 'XFILE' & 'XDEV' GNAME, 0 /GET A FILE OR DEVICE NAME DCA TEMP1 /SET UP "." SWITCH DCA NAM1 DCA NAM2 /CLEAR NAME AREA DCA NAM3 TAD (2326 / & INIT EXTENSION TO "SV" DCA NAM4 TAD (NAM1 / & INIT POINTER FOR NAME DCA TEMP JMS I SSKIPI /SKIP LEADING SPACES JMS I SORTI /TEST FIRST CHAR ARGLST-1 GETOPS-ARGLST TAD CHAR /OK, USE FIRST CHAR AND N77 JMS I RTL6I /INTO LEFT HALF DCA NAM1 JMS GETRHC /2ND CHAR JMS GETLHC /3RD JMS GETRHC /4TH GETSCN, JMS GETLHC /5TH & 1ST EXT. JMS GETRHC /6TH & 2ND EXT. JMS GETNT /SCAN FOR TERMINATOR CLA JMP .-2 / GETPER, ISZ TEMP1 /"." FOUND, FIRST ONE? ERCM, ERROR /NO, THE END... DCA NAM4 /YES, RESET EXT, TAD (NAM4 / SET POINTER DCA TEMP JMP GETSCN / & GO GET IT / GETEND, STA /TERM = SPACE, SET SWITCH DCA CRSWT /TERM = CR, RESET SWITCH JMP I GNAME /..DONE.... GETNT, 0 /GET & TEST A CHAR JMS I GETNI /GET NEXT CHAR JMS I SORTI /TEST IT ARGLST-1 GETOPS-ARGLST TAD CHAR /OK, USE CHAR AND N77 /MASK TO 6 BITS JMP I GETNT / & EXIT WITH IT GETRHC, 0 /GET RIGHT-HALF-CHAR JMS GETNT TAD I TEMP /MERGE WITH LAST LEFT DCA I TEMP ISZ TEMP /BUMP POINTER JMP I GETRHC GETLHC, 0 /GET LEFT-HALF-CHAR JMS GETNT JMS I RTL6I /TO LEFT HALF DCA I TEMP / & STORE IT JMP I GETLHC /ERRORS RETURNED FROM FIELD 1 CCB/HEADER SUBROUTINES ERCF, ERROR /NO FILE KNOWN GCCERR, ERROR /NOT A CCB HDRERR, ERROR /NOT A HEADER PAGE /SUBROUTINE TO READ CHARACTERS FROM USER. IT ALSO CHECKS / FOR RUBOUT AND ^R. RUBOUT CAUSES OS/8 TYPE DELETION OF / CHARS FROM THE COMMAND BUFFER. ^R (FOR RETYPE) ECHOES / THE CURRENT COMMAND BUFFER CONTENTS THE SAME WAY THAT / THE LINE-FEED KEY DOES IN OS/8. ALSO TRANSLATES ALL LOW- / ER CASE CHARACTERS TO UPPER CASE CHARACTERS. READ, 0 /READ AND ECHO INPUT CHARACTER JMS RKEY /GET A CHAR JMP RUBO /RUBOUT, GO BEGIN DELETIONS REKEY, DCA CHAR TAD CHAR TAD (-222 /IS IT A CTRL-R? SNA JMP RECHO /YES, ECHO THE CURRENT LINE TAD (222-225 /IS IT A CTRL-U? SNA CLA JMP RERASE /YES, ERASE CURRENT LINE TAD CHAR JMS I TYPEI ISZ READ JMP I READ / RUBO, JMS BTEST /RUBOUT TYPED,TEST FOR EMPTY JMP RUBOF / INPUT BUFFER EMPTY! JMS I TYPECI /OK, OUTPUT 1ST "\" "\ RUBO1, JMS BTEST /NOW EMPTY? JMP RUBOE / YES, LINE END TAD COMIR /ECHO LAST CHAR IN BUFFER DCA CTRL CDF 10 TAD I CTRL CDF 0 JMS I TYPEI STA TAD COMIR /NOW BACK UP POINTER DCA COMIR JMS RKEY /GET A CHAR JMP RUBO1 /ANOTHER RUBOUT, GO HANDLE DCA BTEST /SAVE IT JMS I TYPECI /NO, DO CLOSING "\" "\ TAD BTEST JMP REKEY /& GO USE NEW CHAR / RUBOE, JMS I TYPECI /BUFFER WAS EMPTIED, "\ /OUTPUT CLOSING "\" RUBOF, JMS I CRLFI / & A CR/LF JMP I READ / RECHO, JMS I TYPECI /ECHO "^R" & THEN "R-100 JMS I CRLFI /ECHO CURRENT LINE TAD COMST /INIT AUTO-XR DCA COMOUT RECHO1, TAD COMOUT /DONE? CIA TAD COMIR SNA CLA JMP READ+1 /YES, MORE INPUT JMS I GETNI /NO, GET NEXT CHAR JMS I TYPEI / & OUTPUT IT JMP RECHO1 / & CONTINUE / RERASE, JMS I TYPECI /OUTPUT "^U" "U-100 JMP RUBOF /GO OUTPUT CR/LF & EXIT BTEST, 0 /TEST FOR COMM. BUFFER EMPTY TAD COMIR CIA TAD COMST SZA CLA /EMPTY? ISZ BTEST /NO, STILL OK, TO CALL+2 JMP I BTEST / OTHERWISE TO CALL+1 RKEY, 0 /GET A NON-NULL CHAR, TEST & TRANSLATE KSF JMP .-1 JMS CTRL KRB AND N177 /MASK OFF PARITY SNA JMP RKEY+1 /NULL CHAR TAD (-177 /IS IT A RUBOUT? SNA JMP I RKEY /YES, EXIT TO CALL+1 ISZ RKEY /NO, EXIT TO CALL+2 TAD (2 /TEST FOR ALT-MODES SMA JMP RKEY1 / 375 OR 376 TAD (35 /IS IT LOWER CASE? SMA TAD (-40 /YES, MAKE UPPER CASE TAD (-35 RKEY1, TAD (375 /RESTORE CHAR & ADD PARITY JMP I RKEY / & EXIT WITH IT CTRL, 0 /CHECK FOR CTRL-C & CTRL-P KSF JMP I CTRL KRS AND N177 /MASK OFF PARITY BIT TAD MCTC /CTRL-C? SNA JMP CTRLC TAD MCTCP /CTRL-P? SZA CLA JMP I CTRL /NO, EXIT KCC DCA LISTSW /YES, RESET LIST SWITCH JMS I TYPECI /OUTPUT "^P" "P-100 JMP I RECRLF / THEN CR/LF & RESTART / /ROUTINE TO EXECUTE THE 'EXIT' COMMAND / XEXIT, CTRLC, DCA LISTSW /RESET LIST SWITCH JMP I M200 / & GO TO SYSTEM MCTC, -"C+300 MCTCP, -"P+"C DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT JMS I TYPECI "0 JMP I DODIG DO1SP, 0 /OUTPUT " " + AC JMS I TYPECI " JMP I DO1SP DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII) JMS I TWOCI 4040 JMP I DO2SP / FAST & SWEET! PAGE /'FPP'/OCTAL/'PDP' OUTPUT ROUTINE FOR ODT ODTOUT, 0 TAD TYPSW /-1, 0, +1 TAD (TAD ODTOL /GENERATE ADDRESS OF DESIRED DCA ODTOPT / OUTPUT ROUTINE ODTOPT, HLT /[USED TWICE!] DCA ODTOPT JMS I ODGETI /GET SPECIFIED WORD JMS I ODTOPT / & OUTPUT IT JMP I ODTOUT FPPDMP /-1 = OCTAL + FPP ODTOL, OPRT / 0 = OCTAL PDPDMP /+1 = OCTAL + PDP /OCTAL & 'PDP' (SYMBOLIC) DUMP ROUTINE PDPDMP, 0 JMS I OCTI /FIRST OUTPUT IN OCTAL SPACE2 /FOLLOWED BY 2 SPACES, JMS PDPOUT / & THEN AS 'PDP' JMP I PDPDMP /'PDP' (SYMBOLIC) INSTRUCTION DECODING PDPOUT, 0 CLA JMS OPRTST /TEST FOR OPR & IOT JMP OPRS / OPR JMS IOPRNT / IOT SYMS, JMS GETOP /GET OP-CODE TO BITS 9-11 RAL / * 2 JMS SYMTYP /OUTPUT 3 CHAR SYMBOL & SPACE INSLST /(TABLE FOR INDEXING) -2 /(- # WORDS) JMS OPRTST /TEST FOR OPR & IOT JMP SYMEND / OPR, DONE JMP IOTS / IOT TADICAD /MEMORY REF., INDIRECT? AND (400 SNA CLA JMP REFS1 /NO JMS I TWOCI /YES, OUTPUT "I " 1140 REFS1, TADICAD /SET UP ADDR BITS AND N177 DCA BITVAL /SAVE THEM TADICAD /IS THIS A 'PAGE 0 REF'? AND N200 SZA CLA TAD LOCL /NO, USE PAGE BITS AND M200 TAD BITVAL /OK, NOW ADD ADDR BITS REFS2, JMS I OCTI /OUTPUT IN OCTAL SYMEND, JMP I PDPOUT /DONE, RETURN / IOTS, TADICAD /USE ONLY LAST 9 BITS AND (777 JMP REFS2 /AND OUTPUT IN OCTAL / OPRS, TADICAD /IS THIS A NOP? AND (777 SNA JMP SYMS /YES, OUTPUT "NOP " AND N200 /IS THERE A CLA IN IT? SNA CLA JMP OPRS1 /NO, CONTINUE JMS SYMTYP /YES, OUTPUT "CLA " CLANAM -2 IAC OPRS1, DCA CNT /SET ANYTHING OUTPUT SWITCH TADICAD /SET UP WORD FOR DECODE JMS I RTL6I RAR DCA BITVAL /SAVE IT TADICAD /CHECK FOR OPR1, OPR2 OR EAE CLL RAR AND N200 SNA JMP OPR1A /OPR1 MICRO-INSTRUCTION SNL CLA JMP OPR2A /OPR2 MICRO-INSTRUCTION / /DO THE DOCODING FOR THE EAE MICRO-INSTRUCTIONS EAE, TAD (EAELST-2 /SET UP EAE LIST POINTER DCA BITPNT JMS BITS /SHIFT & CHECK BIT 5 JMS OPRTYP /IF = 1, "MQA " TAD BITVAL /CHECK BIT 6 CLL RAL /("SCA" IN "A" MODE OF 8/E DCA BITVAL / 'MODE BIT' IN "B" MODE) SZL TAD N20 /IF ON, USE OTHER WORDS DCA EAETMP JMS BITS /CHECK BIT 7 JMS OPRTYP / "MQL " TADICAD AND (16 TAD EAETMP /(ADD SWITCH WORD) JMS SYMLIM /CHECK FOR & OUTPUT LAST INST. -36 /UPPER LIMIT EAETMP, 0 / /DO THE DECODING FOR THE OPR1 MICRO-INSTRUCTIONS OPR1A, TAD (OP1LST-2 /SET OPR1 LIST DCA BITPNT JMS BITS /SHIFT & CHECK BIT 5 JMS OPRTYP /IF = 1, OUTPUT "CLL " JMS BITS /CHECK BIT 6 JMS OPRTYP / "CMA " JMS BITS /CHECK BIT 7 JMS OPRTYP / "CML " ISZ BITPNT /BUMP POINTER ISZ BITPNT TADICAD /LOOK FOR IAC RAR SZL CLA JMS OPRTYP /OUTPUT "IAC " TADICAD /SET UP TO CHECK FOR ROTATES AND (16 JMS SYMLIM /CHECK & OUTPUT -12 /UPPER LIMIT PAGE /OCTAL & 'FPP' (SYMBOLIC) DUMP ROUTINE FPPDMP, 0 JMS I OCTI /FIRST OUTPUT IN OCTAL SPACE2 / THEN 2 SPACES JMS FPPOUT / & THEN AS FPP JMP I FPPDMP /THE FOLLOWING ROUTINES ARE USED BY 'PDPOUT' /DO THE DECODING FOR THE OPR2 MICROINSTRUCTIONS OPR2A, TAD (OP2LST-2 /SET UP LIST POINTER DCA BITPNT JMS BITS /SHIFT & CHECK BIT 5 JMS OPR2T /IF 1, OUTPUT "SMA " OR "SPA " JMS BITS /CHECK BIT 6 JMS OPR2T / "SZA " OR "SNA " JMS BITS /CHECK BIT 7 JMS OPR2T / "SNL " OR "SZL " JMS BITS /CHECK BIT 8 SKP JMP OPR2B /IT WAS 0 TADICAD /MUST CHECK FOR "SKP " AND (160 SNA CLA /ARE ALL SKIP SENSES = 0? JMS OPRTYP /YES, SO OUTPUT "SKP " OPR2B, TAD (OP2LST+14 /SET UP CHECK FOR OSR & HLT DCA BITPNT JMS BITS /CHECK BIT 9 JMS OPRTYP / "OSR " JMS BITS /CHECK BIT 10 JMS OPRTYP / "HLT " JMP OPEND /CHECK FOR ANY DONE SYMLIM, 0 /CHECK LAST SYMBOL AGAINST LIMIT DCA CHAR /SAVE AC TAD CHAR SPA SNA /IS IT > 0? JMP OPEND /NO, TEST IF ANY OUTPUT DONE TAD I SYMLIM /IT IS > UPPER LIMIT? SMA SZA CLA JMP OPEND /NO, GO CHECK AGAIN TAD CHAR /CALCULATE ADDRESS JMS OPRTYP / & OUTPUT LAST JMP SYMEND /...DONE / OPEND, CLA TAD CNT /ANYTHING OUTPUT? SZA CLA JMP SYMEND /YES, DONE WITH OUTPUT JMS SYMTYP /NO, OUTPUT "OPR " OPRMES -2 JMP IOTS /NOW GO OUTPUT LAST 9 BITS BITS, 0 /DECODE A WORD ONE BIT AT A TIME TAD BITVAL /SHIFT A BIT INTO LINK CLL RAL DCA BITVAL /SAVE FOR LATER ISZ BITPNT /BUMP SYMBOL POINTER ISZ BITPNT SNL ISZ BITS /TO CALL+2 IF L = 0 JMP I BITS OPRTYP, 0 /OUTPUT AN OPR SYMBOL JMS SYMTYP /OUTPUT THE SYMBOL BITPNT, 0 /ADDRESS -2 ISZ CNT /SET SWITCH JMP I OPRTYP SYMTYP, 0 /OUTPUT A SYMBOL TAD I SYMTYP /ADD TABLE ADDR TO ANY INDEX ISZ SYMTYP DCA SYMPNT /SAVE POINTER TAD I SYMTYP /GET COUNT OF WORDS ISZ SYMTYP DCA BITS / & SAVE IT SYMNXT, CDF 10 /"SYMBOL"S IN FIELD 1 TAD I SYMPNT CDF 0 JMS I TWOT /OUTPUT A PAIR OF LETTERS ISZ SYMPNT ISZ BITS /DONE? JMP SYMNXT JMP I SYMTYP SYMPNT, 0 OPR2T, 0 /OUTPUT AN OPR2 SYMBOL TADICAD AND (10 /IF BIT IS ON, REVERSE THE JMS OPRTYP /SENSE OF THE SKIP JMP I OPR2T BITVAL, 0 IOPRNT, 0 /OUTPUT I/O NAMES TAD (IOTTAB /SET UP POINTER IOPRN1, DCA IOPNT /SET (OR UPDATE) POINTER CDF 10 TAD I IOPNT /GET NEXT IOT CDF 0 SNA /AT END OF TABLE? JMP I IOPRNT /YES, CODE NOT FOUND CIA TADICAD /NO, DO THEY MATCH? SNA CLA JMP IOPRN2 /YES, OUTPUT NAME TAD (4 /NO, UPDATE POINTER TAD IOPNT JMP IOPRN1 / & TRY AGAIN / IOPRN2, IAC /WORD FOLLOWS CODE JMS SYMTYP /OUTPUT THE MNEMONIC IOPNT, 0 -3 JMP SYMEND / & RETURN OPRTST, 0 /TEST "INSTRUCTION" FOR OPR & IOT TADICAD /GET WORD AND N7000 /MASK OFF OP CODE TAD (1000 /IS IT AN OPR? SNA JMP I OPRTST /YES, EXIT TO CALL+1 ISZ OPRTST TAD (1000 /IS IT AN IOT? SZA CLA ISZ OPRTST /NO, EXIT TO CALL+3 JMP I OPRTST / YES, TO CALL+2 PAGE /'FPP' (SYMBOLIC) INSTRUCTION DECODING FPPOUT, 0 CLA /HARD TO TELL WHAT MIGHT COME! TADICAD /GET THE WORD AND (600 /MASK OFF MODE BITS SNA JMP SPECIAL / NON-ARITHMETIC TAD M400 /GIVES: -=BASE, 0=LONG, +=INDIR. DCA TEMP2 JMS GETOP /GET OP-CODE TO BITS 9-11 FPLEA, JMS MULT3 /MULTIPLY BY 3 (WORDS/OP OUT) JMS SYMTYP /OUTPUT 6 CHAR OPR SYMBOL FPPINS /(INCLUDING "LEA") -3 TAD TEMP2 /NOW HANDLE MODE SNA JMP LONG / LONG INDEXED SMA CLA JMP INDIR / INDIRECT INDEXED BASE, JMS I TYPSI / BASE - OUTPUT " B+" MSBASE TADICAD /GET WORD AGAIN AND N177 / MASK OFF OFFSET JMS MULT3 / MULTIPLY IT BY 3 JMS OCT3 / & OUTPUT IN OCTAL JMP I FPPOUT / INDIR, JMS I TYPSI /OUTPUT "% B+" MSINDI TADICAD /GET WORD AGAIN AND N7 / MASK OFF OFFSET JMS MULT3 / MULTIPLY IT BY 3 JMS OCT3 / & OUTPUT IT IN OCTAL JMP XRPLUS /FINALLY DO XR OUTPUT / LONG, JMS I TWOCI /OUTPUT "# " 4340 JMS FLDOUT /AND FIELD AND "*" XRPLUS, JMS GET678 /GET XR FIELD JMS I TWOCI / & OUTPUT ",X" WHERE 5460 / "X" IS A DIGIT TADICAD /GET WORD THE LAST TIME AND (100 / AND CHECK "+" BIT SZA CLA JMS I TYPECI /OUTPUT "+" OR SKIP "+ /[A NOP] JMP I FPPOUT / SPECIAL,JMS GETOP /GET OP-CODE JMS I SORTI / & BRANCH ON IT FPPMO0-1 FPPMOJ-FPPMO0 SPCOP0, TADICAD /FALLS THRU ON 0, GET AND (170 / SUB-OP-CODE JMS I SORTI / & BRANCH ON IT FPPOP0-1 FPPOPJ-FPPOP0 SPOP00, TADICAD /FALLS THRU ON 0, USE AS AND N7 / INDEX INTO LAST LIST IAC SPOP04, JMS MULT3 /THREE WORDS/SYMBOL JMS SYMTYP /OUTPUT ONE OF SEVERAL FPOP00 / SYMBOLS IN THIS LIST -3 JMP I FPPOUT / SPOP05, CLL STA /= -1 JMP SPOP04 /OUTPUT "STARTE" / SPNUSE, CLL STA RAL /= -2 JMP SPOP04 /OUTPUT "UNUSED" / SPO123, JMS GET678 /"ALN X", "ATX X", "XTA X" CLL RAL /(2 WORDS PER) JMS SYMTYP /OUTPUT SYMBOL FPXR1S-2 -2 JMP XROUT / & XR VALUE / SPOP10, TAD (4 /"LDX *,X" SPOP11, JMS SYMTYP /"ADDX *,X" FPXR2S -4 XROUT, TADICAD /GET XR FIELD AND N7 DIGIT / & OUTPUT AS DIGIT JMP I FPPOUT / SPCOP1, TADICAD /GROUP 0 OR 1? AND (100 SNA CLA JMP SPOP1J / 1 = CONDITIONAL JUMPS JMS GET678 / 0 = SETS, ETC. TAD (-4 /SUB-OP-CODES 0 THRU 3? SMA CLA JMP SPNUSE / NO, 4 THRU 7 = UN-USED JMS GET678 /0 THRU 3: SETX,SETB,JSA,JSR IAC / +1+1 => 2 THRU 5 SPCOP3, IAC / 1: TRAP3 SPCOP4, JMS MULT3 / 0: TRAP4 JMS SYMTYP /GO DO ONE OF THESE FOP134 -3 JMP DOFLD /FINISH WITH FIELD / SPOP1J, JMS CONDIT /CONDITIONAL JUMPS 1200 / "J--" SPACE2 DOFLD, JMS FLDOUT /OUTPUT FIELD & "*" JMP I FPPOUT / SPCOP2, JMS I TYPSI /OUTPUT "JNX " MSJNX JMP XRPLUS-1 / & HANDLE ADDRESS / / SPCOP3 & SPCOP4 / SPCOP5, TADICAD /GET WORD AGAIN AND (100 SZA CLA JMP SPNUSE /BIT 5 ON IS UNUSED OP JMS CONDIT /LOAD TRUTH 1424 / "LT--" JMP I FPPOUT / SPCOP7, IAC / "LEA" INDIRECT, SET SWITCH SPCOP6, DCA TEMP2 / "LEA" LONG, SET SWITCH CLL STA JMP FPLEA / & GO DO OUTPUT PAGE TYPE1, 0 /OUTPUT ASCII CHARACTER IN THE AC TAD I TYPE1 /GET ARG, IF ANY ISZ TYPE1 DCA ENDC JMS I CTRLI TAD LISTSW /LISTING? SZA CLA TAD LISTAD / WITH LPT AVAILABLE? SZA CLA JMP TYPE2 /YES TO BOTH, OUTPUT TO LPT TAD ENDC TSF JMP .-1 TLS CLA JMP TYPE3 / TYPE2, TAD ENDC /PUT CHAR IN OUTPUT BUFFER CDF 10 DCA I LPNT CDF 0 ISZ LPNT /BUMP POINTER TAD ENDC /WAS LAST CHAR "LINE-FEED"? TAD (-212 SZA CLA JMP TYPE3 /NO, BUMP POSITION & EXIT TAD LPNT /YES, IS BUFFER FULL? TAD (-OUTBUF-400-1 SZA CLA JMP TYPE2+1 /NO, FILL WITH 0'S JMS I LISTAD /OK, GO DUMP BUFFER 4210 /WRITE, 2 PAGES, FIELD 1 LPBUF, OUTBUF /LPT BUFFER 7777 /ALWAYS!--TRY TO SAVE MASS STORAGE ERC10, ERROR /HANDLER ERROR TAD LPBUF /RESET POINTER DCA LPNT TYPE3, ISZ NCNT /BUMP LINE POSITION JMP I TYPE1 / & EXIT LISTAD, 0 /ADDRESS OF LPT HANDLER ENTRY CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED CLA JMS TYPE1 N215, 215 JMS TYPE1 212 DCA NCNT /RESET LINE POSITION JMP I CRLF TYPEC, 0 /OUTPUT A SINGLE CHAR ARG TAD I TYPEC /GET IT ISZ TYPEC JMS TYPE /OUTPUT IT JMP I TYPEC TYPE, 0 /CHARACTER OUTPUT ROUTINE AND N377 /BE SURE ONLY 8 BITS SNA TAD CHAR /USE CHAR IF AC = 0 DCA TCHAR /CHAR TO OUTPUT TAD TCHAR JMS I SORTI /CHECK FOR SPECIALS TYPEL-1 TYPEOP-TYPEL TAD TCHAR /IS TCHAR < 240? TAD M240 SPA CLA JMP TYPCTL /NO, OUTPUT AS CTRL-CHAR TYPC, JMS TYPE1 /NOW OUTPUT CHAR TCHAR, 0 JMP I TYPE / TYPALT, JMS TYPE1 /OUTPUT "$" FOR ALT-MODES "$ JMP I TYPE / TYPCR, JMS CRLF /C.R. TO OUTPUT JMP I TYPE / TYPTAB, JMS TYPE1 /SPACE OVER FOR TAB " TAD NCNT /TAB TO OUTPUT TAD M10 SNA JMP I TYPE SMA JMP TYPTAB+3 /REDUCE BY TAB SIZE CLA JMP TYPTAB / TYPCTL, JMS TYPE1 /CONTROL-CHAR, OUTPUT AS "^ TAD C100 / "^","CHAR+100" JMP TYPC C100, 100 /SUBROUTINE TO TERMINATE COMMAND BUFFER WITH A C.R. /RETURN TO CALL+1 IF ONLY A CR (EXCLUDING LEADING /SPACES) IN BUFFER, TO CALL+2 IF ANYTHING ELSE. ENDC, 0 TAD N215 /PUT A CR IN BUFFER CDF 10 DCA I COMIR CDF 0 TAD COMST /INIT'L BUFFER UNLOAD DCA COMOUT TAD CHAR /SAVE CHAR FOR POSSIBLE DCA TEMP / USE BY 'WCHEK' JMS I GETNI /GET FIRST CHARACTER JMS I SSKIPI /SKIP LEADING SPACES TAD CHAR /GET 1ST NON-SPACE TAD M215 /IS IT A CR? SZA CLA /YES, NOTHING IN BUFFER ISZ ENDC /OTHERWISE RETURN TO CALL+2 JMP I ENDC GETN, 0 /GET NEXT CHAR FROM COMM. BUFF. CDF 10 TAD I COMOUT CDF 0 DCA CHAR JMP I GETN /SUBROUTINE TO CLOSE A LOCATION CLOSE, 0 JMS I ARGI /GET ONE ARG ISZ SHUT /ANYTHING OPEN? JMP I CLOSE /NO, RETURN JMS I ODGETI /YES, SET UP THINGS RIGHT STA DCA MODIF /SET MODIFY FLAG TAD ACC1 /USE "LOC" AS DATA DCAICAD /STORE IT JMP I CLOSE PAGE /INPUT AN UNSIGNED 24 BIT NUMBER ACCEPT, 0 DCA ACC1 /CLEAR LO DCA ACC2 / & HI WORDS DCA DADD / & LEGAL INPUT SWITCH JMS I SSKIPI /GET FIRST NON-SPACE SKP ACCPT1, JMS I GETNI /DON'T IGNORE SPACES JMS I SORTI /CHECK FOR ^D, ^K, (, ", ', GWLST1-1 / DIGITS, SPACE ACOPS-GWLST1 JMP ACCPT3 /NONE OF THE ABOVE / ACCNUM, TAD CHAR TAD (-"0 /MAKE A DIGIT DCA OCTSET TAD OCTSET /IS DIGIT LEGAL? CIA TAD ACBASE SPA SNA CLA ERC09, ERROR / NO, ILLEGAL DIGIT! ACCMUL, TAD ACBASE /SET UP MULTIPLY OF PREVIOUS DCA OPER1 / BY BASE DCA OPER2 JMS DMUL / DO MULTIPLY TAD OCTSET /SET UP ADD OF NEXT "DIGIT" DCA OPER1 DCA OPER2 JMS DADD /OK, DO THE ADD (& SET SWITCH) JMP ACCPT1 / STA / SPACE HERE DCA CRSWT /SET SWITCH: CR HERE ACCPT3, TAD DADD /TERMINATING CHAR RECEIVED SNA CLA /CHECK FOR LEGAL INPUT ERCR, ERROR /YOU CAN'T OUT-SMART ME! JMP I ACCEPT ACBASE, 10 / / DQUOTE, JMS QUOTEC / " - GET SINGLE CHAR DCA OCTSET / SAVE VALUE JMP ACCMUL / & USE IT AS A "DIGIT" / SQUOTE, JMS QUOTEC / ' - PACKED ASCII, GET 1ST AND N77 /MASK TO 6 BITS JMS I RTL6I /MOVE TO LEFT HALF DCA OCTSET / & SAVE IT JMS QUOTEC /GET 2ND CHAR AND N77 /MASK TAD OCTSET /MERGE JMP DQUOTE+1 / & USE THIS AS A "DIGIT" / CTRLD, TAD (2 / ^D - SET RADIX TO DECIMAL CTRLK, JMS OCTSET / ^K - SET RADIX TO OCTAL JMP ACCPT1 /SUB. TO SET UP FOR OCTAL/DECIMAL INPUT. CALLED FROM / COMMAND INPUT & MODIFY & IF AN "^K"/"^D" IN INPUT. OCTSET, 0 /SET UP FOR OCTAL/DECIMAL INPUT TAD (10 /ENTER WITH AC= 2 FOR DECIMAL DCA ACBASE JMP I OCTSET QUOTEC, 0 /GET A QUOTED CHARACTER JMS CGTEST /GET & TEST FOR A CR ERC13, ERROR / ILLEGAL USE OF " OR ' TAD CHAR /OK, RETURN WITH IT JMP I QUOTEC /SUBROUTINE TO DEVELOP ARGUMENTS FROM THE COMMAND /BUFFER, AND RETURN WITH -(#) OF ARGS IN 'TEMP'. GARGS, 0 TAD TEMPST /GET BUFFER ADDRESS DCA DPNT DCA TEMP /ZERO THE NUMBER OF ARGS GAR1, STA DCA TEMP1 /SET BLK TO -1 STA DCA CNT /RESET SWITCH GAR2, JMS EXPRIN /GET NEXT ARG JMS I SSKIPI /IGNORE TRAILING SPACES JMS I SORTI /BRANCH ON TERMINATOR GARLST-1 GAROPS-GARLST ERCS, ERROR /ILLEGAL TERMIN., FLAME OUT / GAR3, JMS GPUT /CR FOUND, END TAD TEMPST /SET UP POINTER FOR DCA DPNT / GETTING RESULTS JMP I GARGS / GAR4, JMS I GETNI /SKIP OVER "." TAD ACC1 /.= TERMIN (BLOCK PART) JMP GAR1+1 /SET BLOCK & GET NEXT / GAR5, TAD ACC1 /-= TERMIN (LOC PART) DCA TEMP2 JMS I GETNI /SKIP OVER "-" JMP GAR2-1 /GO SET SWITCH / GAR6, JMS GPUT /,= TERMIN JMS I GETNI /SKIP OVER "," JMP GAR1 /SUBROUTINE TO PUT THE DEVELOPED ARGS IN THE ARG /BUFFER. ALL ARGUMENTS ARE STORED IN 4 WORDS IN /THE BUFFER, AS SPECIFIED BY: / BLOCK.LOC1-LOC2 (TERMINATED BY , OR C.R.) /AS: /I-------I-------I-------I-------I----- /I WORD1 I WORD2 I WORD3 I WORD4 I ETC. /I-------I-------I-------I-------I----- /WHERE: / WORD1= BLOCK (OR -1 IF NONE SPECIFIED) / WORD2= LOC (HIGH) [ONLY 3 BITS, LOC2 IF SPEC'D] / WORD3= LOC1 (LOW) / WORD4= LOC2-LOC1-1 (LOC2=LOC1 IF NOT / SPECIFIED) [ONLY 12 LOW BITS USED] GPUT, 0 TAD TEMP1 DCA I DPNT /SET BLOCK ISZ CNT /WAS A LOC2 SPECIFIED? JMP GPUT1 /YES, OK TAD ACC1 DCA TEMP2 /NO, MAKE ARGS SAME GPUT1, TAD ACC2 /STORE HIGH ADDR AND N7 /MASKED TO 3 BITS DCA I DPNT TAD TEMP2 /USE 1ST ARG DCA I DPNT TAD ACC1 CMA TAD TEMP2 DCA I DPNT /DIFF= (TEMP2-ACC1-1) STA TAD TEMP /ANOTHER ENTRY DCA TEMP JMP I GPUT COSOUT, 0 /COS-300 FORMAT PACKED ASCII JMS I RTR6I /USE HIGH 6 BITS FIRST AND N77 SPACE1 / ADDING THEM TO A SPACE TADICAD /THEN USE LOW 6 BITS, AND N77 SPACE1 / ADDING THEM TO A SPACE JMP I COSOUT /...THAT'S ALL FOLKS!... PAGE /ROUTINE TO EVALUATE THE PARENTHESIZED EXPRESSION /OF DOUBLE PRECISION INTEGERS IN THE COMMAND BUFFER. /IT CALLS ITSELF RECURSIVELY TO EVALUATE EXPRESSIONS /IN "(...)", PLACING INFORMATION ON A PUSH-DOWN-LIST /OR DOING ARITHMETIC ACCORDING TO OPERATOR PRECIDENCE. / /OPERATIONS (IN ORDER OF PRECIDENCE): / OR AND ADD SUB DIV MPY / ! & + - / * /ALL ARITHMETIC IS DONE IN DOUBLE-PRECISION SIGNED /INTEGER. OVERFLOW ON MULTIPLY, ADD OR SUBTRACT IS /IGNORED BUT DIVIDE BY 0 WILL CAUSE AN ERROR. EVAL, 0 DCA OPER2 /0 => D.P. TEMP (NEW NUMBER DCA OPER1 / OR LAST RESULT). DCA LASTOP /0 => LASTOP JMS I TERMTI /GET NEXT & TEST FOR TERM. JMP EVAL1 /TERM, CHECK IT JMP ENUM / IT MUST BE A NUMBER EVAL1, JMS I SORTI /CHECK LEGAL TERMS EVLST1-1 /"+","-" & "(" EVOPS1-EVLST1 ERCT, ERROR /SORRY ABOUT THAT EVAL2, JMS I LPARI /IS CHAR "("? ERCU, ERROR /YES,ILLEGAL (NO OP FIRST) EVMIN, TAD CNTRA /SEQN # OF TERMINATOR DCA THISOP /SET UP THISOP TAD CNTRA /IS IT ")" OR "CR"? TAD M10 SMA CLA DCA THISOP /YES, 0 => THISOP EVAL3, TAD THISOP /CHECK PRIORITIES CIA TAD LASTOP /IS LASTOP < THISOP? SPA CLA JMP EVPAR /YES, CONTINUE SCAN TAD THISOP / IS THISOP+LASTOP=0? TAD LASTOP SNA CLA JMP I EVAL /YES, DONE TAD LASTOP /NO, DO THIS OP NOW TAD EVTAB DCA EVOP /SET UP OPERATION TAD LASTOP /IS THIS =0? SNA CLA JMP EVOP /YES, DO OP POP /NO, POP LAST OFF LIST DCA ACC2 / INTO D.P.AC. POP DCA ACC1 EVOP, HLT /JMS TO OPERATION ROUTINE TAD ACC2 DCA OPER2 /DUPLICATE D.P.AC. INTO TAD ACC1 DCA OPER1 / D.P. TEMP POP DCA LASTOP /POP UP ANOTHER OLD OPERATOR JMP EVAL3 /AND GO DO IT EVPAR, JMS I LPARI /IS CHAR A "("? JMP EVLPAR /YES, GO DO A SUB-EXPRESSION TAD LASTOP /NO, PUSH DOWN OLD OP PUSH TAD OPER1 / & D.P. TEMP (LAST PUSH TAD OPER2 / RESULT OR NEW NUMBER). PUSH TAD THISOP /UPDATE LASTOP DCA LASTOP EVNEXT, JMS I TERMTI /GET NEXT & TEST FOR TERM. JMP EVLPAR /TERM, MUST BE A "(" ENUM, JMS I SORTI /CHECK FOR "C","B", ETC... EVLST2-1 EVOPS2-EVLST2 JMS ACCEPT /GET A # OR BOMB OUT! STA TAD COMOUT /BACK UP POINTER DCA COMOUT ENUMX, TAD ACC1 DCA OPER1 /LO ORDER PART TAD ACC2 DCA OPER2 /HI ORDER PART JMP EVOPN /GO CHECK TERMINATOR / EVDATE, CDF 10 /"D" -- USE DATE WORD TAD I (7666 /GET DATE WORD CDF 0 JMP EVBLK+1 EVREM, TAD ACCX1 /"R" -- USE REMAINDER DCA ACC1 TAD ACCX2 / AS NEXT "INPUT". JMP EVBLK+2 EVSR, LAS SKP /"S" -- USE SWITCHES TADICAD /"C" -- USE CONTENTS JMP EVBLK+1 EVFIL, TAD FILLER /"F" -- USE FILLER JMP EVBLK+1 EVLOC, TAD LOCL /"L" -- USE LOCATION DCA ACC1 TAD LOCH JMP EVBLK+2 EVBLK, TAD BLK /"B" -- USE BLOCK DCA ACC1 /INTO LO ORDER PART DCA ACC2 /0 HIGH ORDER PART JMP ENUMX /CHECK NEXT CHARACTER EVLPAR, JMS I LPARI /IS CHAR "("? SKP ERCV, ERROR /NO, DIE! (ILLEGAL OPERATOR) EVPAR2, TAD LASTOP /PUSH DOWN LASTOP PUSH TAD EVAL /PREPARE TO RE-CALL PUSH JMS EVAL /RECURSIVE CALL POP DCA EVAL /RESTORE RETURN ADDR TAD CNTRA /WAS CHAR ")"? TAD M10 SZA CLA ERCW, ERROR /NO, NOT ENOUGH PARENS POP DCA LASTOP /RESTORE LASTOP EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM. JMP EVAL2 /OK JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR LPARI, LPAR TERMTI, TERMT EVTAB, JMS I . /JMS THRU TABLE TO OPERATIONS DIOR /INCLUSIVE OR DAND /AND DADD /ADD DSUB /SUBTRACT DDIV /DIVIDE DMUL /MULTIPLY PAGE PUSHX, 0 /PUSH AC ONTO LIST CDF 10 DCA I PDLPT CDF 0 ISZ PDLPT /BUMP POINTER JMP I PUSHX POPX, 0 /POP LIST INTO AC STA STL /SET LINK SO IT WILL BE 0 TAD PDLPT /BACK UP POINTER DCA PDLPT CDF 10 TAD I PDLPT CDF 0 JMP I POPX LPAR, 0 /CHECK IF CHAR = "(" TAD CHAR TAD (-"( SZA CLA ISZ LPAR /IF IT IS NOT, TO CALL+2 JMP I LPAR / ELSE TO CALL+1 /COMPARE CHAR AGAINST LIST OF TERMINATORS. IF IT /IS ONE, RETURN TO CALL+1, ELSE TO CALL+2. TERMT, 0 CLA CLL JMS I GETNI /GET NEXT CHARACTER JMS I SSKIPI /IGNORE SPACES TAD (TERMS-1 /SET UP POINTER DCA SPNT DCA CNTRA /SET CNTRA TO 0 TERMT1, CDF 10 TAD I SPNT /GET AN ITEM CDF 0 ISZ CNTRA /ADD 1 TO ITEM # SNA JMP TERMTE /WAS 0, END CIA TAD CHAR /SAME AS THIS? SNA CLA JMP I TERMT /YES, TO CALL+1 JMP TERMT1 TERMTE, ISZ TERMT /DIDN'T FIND IT, TO JMP I TERMT / CALL+2 /DOUBLE-PRECISION ROUTINES DADD, 0 /D.P. ADD CLL TAD OPER1 TAD ACC1 /ADD LOW ORDER PARTS DCA ACC1 RAL /GET CARRY TO AC11 TAD OPER2 /ADD HIGH ORDER PARTS TAD ACC2 DCA ACC2 /STORE HIGH ORDER PART JMP I DADD DSUB, 0 /D.P. SUBTRACT DCA DPSGN /ZERO IT FOR SAFETY JMS MULNEG /NEGATE OPERAND JMS DADD / & ADD JMP I DSUB DAND, 0 /D.P. LOGICAL AND TAD ACC2 /AND HIGH ORDER PARTS AND OPER2 DCA ACC2 TAD ACC1 /AND LOW ORDER PARTS AND OPER1 DCA ACC1 JMP I DAND /RETURN DIOR, 0 /D.P. LOGICAL INCLUSIVE OR TAD ACC2 /IOR HIGH ORDER PARTS CMA AND OPER2 TAD ACC2 DCA ACC2 TAD ACC1 /IOR LOW ORDER PARTS CMA AND OPER1 TAD ACC1 DCA ACC1 JMP I DIOR /SUBROUTINE TO GET SINGLE ARGS FROM THE COMMAND /BUFFER. MUST BE IN 'BLOK.LOC' FORM. ONLY ".", /SPACE AND CR ARE ALLOWED OTHER THAN DIGITS. ARG, 0 STA ARG1, DCA TEMP1 /SET 'BLOK' [INIT TO -1] JMS EXPRIN / GET AN ARG JMS I SORTI /LOOK UP TERMINATOR ARGLST-1 ARGOPS-ARGLST ERCQ, ERROR /ILLEGAL TERMINATOR / ARG2, JMS I GETNI /SKIP OVER "." TAD ACC1 /TERM = ".", SET 'BLOK' JMP ARG1 / ARG3, JMP I ARG /TERM = " " OR CR /GET NEXT ARG FROM COMM. BUFF. IF NEXT CHAR IS / A "(", USE 'EVAL' TO GET IT, OTHERWISE USE / 'ACCEPT'. EXPRIN, 0 JMS I SSKIPI /IGNORE SPACES JMS LPAR /IS CHAR A "("? JMP EXPRI1 JMS ACCEPT /NO, MUST BE A NUMBER JMP I EXPRIN / EXPRI1, JMS I EVALI /YES, GO EVALUATE EXPRESSION TAD CHAR /WAS TERMIN A ")"? TAD (-") SZA CLA ERC08, ERROR /NO, ILLEGAL TERMINATOR JMS CGTEST /OK, SKIP OVER ")" & TEST FOR CR SKP STA /NO, SET SWITCH DCA CRSWT /YES, RESET IT JMP I EXPRIN / & LEAVE... SCANER, 0 /EXECUTION SUBROUTINE FOR 'SCAN' COMMAND CLA TAD BLK /SET UP DESIRED BLOCK DCA CBLK JMS GETIO /DO NECESSARY I/O SKP CLA / READ ERROR! JMP I SCANER /THIS BLOCK IS OK! TAD BLK JMS I OCTI /OUTPUT BLOCK NUMBER JMS I TYPSI / & TELL IT'S BAD MSBAD JMS I CRLFI / TO ANOTHER LINE JMP I SCANER PAGE /SIGNED MULTIPLY AND DIVIDE ROUTINES DMUL, 0 JMS MDCOM /MAKE DPAC POS, INITIALIZE SPA CLA /MAKE SURE MULTIPLIER IS POSITIVE JMS MULNEG / IT WAS NEG, MAKE POS & SET SIGN DMUL1, TAD ACC2 /SHIFT RIGHT & OUT RAR DCA ACC2 /THRU HI OF LO TAD ACC1 RAR DCA ACC1 /THRU LO OF LO INTO LINK ISZ DPNEG /DONE YET? JMP DMUL2 /NO, CONTINUE DMUL4, TAD DPSGN /YES, CHECK SIGN OF RESULT RAR SZL CLA /SKIP IF SIGN OK JMS DPNEG /NOT OK, NEGATE JMP I DMUL / DMUL2, SNL /ADD IN THIS TIME? JMP DMUL3 /NO, BIT OUT WAS 0 CLA CLL /YES, BIT WAS 1 TAD OPER1 /START WITH LOW TAD ACCX1 DCA ACCX1 CLA RAL /GET CARRY TAD OPER2 /ADD HIGH PARTS DMUL3, TAD ACCX2 /AND BEGIN SHIFTING OUT RAR DCA ACCX2 TAD ACCX1 RAR DCA ACCX1 JMP DMUL1 DDIV, 0 TAD DDIV /MOVE RETURN ADDRESS DCA DMUL JMS MDCOM /MAKE DPAC POS, INITIALIZE SMA CLA /IS DIVISOR NEGATIVE? JMS MULNEG / NO, NEGATE IT & SET SIGN SZL / IS IT 0? (CARRY OUT ON NEGATE) ERCX, ERROR / YES, YOU LOST ISZ DPSGN /CORRECT FOR SIGN DIF IN * & / DDIV1, TAD ACCX1 /SUBTRACT LO OF LO TAD OPER1 DCA ACCX1 CLA RAL /CARRY TO AC TAD ACCX2 /SUBTRACT HI OF LO TAD OPER2 SPA /TOO FAR? JMP DDIV2 /YES CLL CML /NO, SET LINK DCA ACCX2 JMP DDIV3 DDIV2, CLA TAD OPER1 /RESET LO ORDER PART CIA TAD ACCX1 DCA ACCX1 CLL /RESET LINK DDIV3, TAD ACC1 /BEGIN SHIFTING RAL DCA ACC1 TAD ACC2 RAL DCA ACC2 ISZ DPNEG /DONE YET? SKP JMP DMUL4 /YES, CHECK SIGN & RETURN TAD ACCX1 /NO, KEEP SHIFTING RAL DCA ACCX1 TAD ACCX2 RAL DCA ACCX2 JMP DDIV1 MDCOM, 0 /COMMON ROUTINE FOR MULTIPLY & DIVIDE DCA DPSGN /RESET SIGN TAD ACC2 /IS DPAC POS? SPA CLA JMS DPNEG /NO, NEGATE DCA ACCX2 / 0 => DPACX DCA ACCX1 TAD (-31 /INITIALIZE COUNTER DCA DPNEG CLL TAD OPER2 /RETURN W. HIGH OPERAND JMP I MDCOM MULNEG, 0 /NEGATE THE MULTIPLIER/DIVISOR TAD OPER1 /DO LO-ORDER PART CLL CIA DCA OPER1 TAD OPER2 /DO HI-ORDER PART CMA SZL /CARRY? CLL IAC /YES, ADD IT IN DCA OPER2 ISZ DPSGN /SIGN CHANGE MADE JMP I MULNEG DPNEG, 0 /NEGATE THE D.P.AC. TAD ACC1 /DO LO-ORDER PART CLL CIA DCA ACC1 TAD ACC2 /DO HI-ORDER PART CMA SZL /CARRY? CLL IAC /YES, ADD IT IN DCA ACC2 ISZ DPSGN /SIGN CHANGE MADE JMP I DPNEG BLKTST, 0 /TEST & SET BLK DCA DPNEG /SAVE DATA TAD DPNEG /GET IT BACK AGAIN ISZ DPNEG /LEGAL BLOCK NUMBER? DCA BLK / YES IF NOT 7777 (-1) CLA / IF NOT, CLEAR JUNK JMP I BLKTST DICAD, 0 /"DCA I CAD" IN FIELD 1 CDF 10 DCA I CAD CDF 0 JMP I DICAD TICAD, 0 /"TAD I CAD" IN FIELD 1 CDF 10 TAD I CAD CDF 0 JMP I TICAD PAGE /CHECK IF THE COMMAND BUFFER STARTS WITH A WORD. IF /IT DOES, RETURN TO 'MAIN3' WITH THE SPECIAL CHAR- /ACTER AND JUST USE IT AS PART OF THE COMMAND STRING. /IF IT DOES NOT, TEST FOR EXPRESSIONS [IN "(...)", /TO ALLOW CHARACTERS IN THE EXPRESSIONS TO NOT BE /TAKEN AS COMMAND CHARACTERS] AND SINGLE & DOUBLE /QUOTES [THE FOLLOWING CHARACTER OR CHARACTERS ARE /LITERALS, NOT COMMANDS]. IF THE PARENS MATCH AND /THE QUOTES ARE FOLLOWED BY THE CORRECT NUMBER OF /CHARACTERS, THEN THE LAST CHARACTER WAS AN "ODT" /COMMAND TO BE EXECUTED SO RETURN TO CALL+1. OTHER- /WISE RETURN TO 'MAIN3' AS ABOVE. WCHEK, 0 JMS I GWORDI /COM BUF BEGIN WITH A WORD? JMP WCHEK2 /NO, TEST FOR PARENS, ETC. WCHEK1, STA TAD COMIR /YES, BACK UP COMIR DCA COMIR TAD TEMP /AND USE THE SPECIAL CHAR AS JMP I .+1 / PART OF THE COMMAND STRING MAIN3 / WCHEK2, STA TAD COMOUT /SET UP ANOTHER A-XR DCA DPNT DCA CNT /RESET (OR SET) PAREN COUNT WCHEK3, TADIDP /GET A CHAR FROM COMM. BUFF. JMS I SORTI / & GO TEST IT WCKLST-1 WCKOPS-WCKLST JMP WCHEK3 /NONE, CONTINUE SCAN / WCHEK4, TAD CNT /CR, DO PARENS MATCH? SZA CLA JMP WCHEK1 /NO, CONTINUE COMMAND INPUT JMP I WCHEK /YES, INPUT IS DONE / WCHEK5, STA CLL RAL /SET TO -2 IAC /AC = +1 OR -1 TAD CNT / UPDATE PAREN COUNT JMP WCHEK3-1 / & CONTINUE SCAN / WCHEK6, JMS WCHONE / ' -- 2 CHARACTERS JMS WCHONE / " -- 1 CHARACTER JMP WCHEK3 /OK, CONTINUE SCAN WCHONE, 0 TADIDP /GET NEXT CHAR TAD M215 /IS IT A CR? SNA CLA JMP WCHEK1 /YES, DON'T EXECUTE SPECIAL JMP I WCHONE /NO, OK /FPP INSTRUCTION DECODING SUPPORT SUBROUTINES GETOP, 0 /GET OP-CODE (BITS 0-3) TO BITS 9-11 TADICAD AND N7000 CLL RTL RTL JMP I GETOP GET678, 0 /GET BITS 678 TO BITS 9-11 TADICAD CLL RTR RAR AND N7 JMP I GET678 MULT3, 0 /MULTIPLY AC BY THREE DCA GETOP TAD GETOP CLL RAL TAD GETOP /WORKS FOR POS OR NEG! JMP I MULT3 CONDIT, 0 /OUTPUT CONDITIONAL FPP INSTRUCTION TAD I CONDIT /GET LEADING 1 OR 2 CHARS ISZ CONDIT JMS I TWOT / & OUTPUT THEM JMS GET678 /GET CONDITION CODE JMS I SYMTYI / AS INDEX TO TABLE FPCOND -1 JMP I CONDIT SYMTYI, SYMTYP FLDOUT, 0 /OUTPUT FIELD DIGIT & "*" TADICAD AND N7 /GET FIELD JMS I RTL6I / TO BITS 3-5 JMS I TWOCI / & OUTPUT "F*" 6052 / WHERE "F" IS DIGIT JMP I FLDOUT DECIMAL /SET RADIX TO DECIMAL TEMPL= . /ARGUMENT BUFFER /L(TEMPL)=180(10) F0END= TEMPL+180 LISHAN-F0END /(SHOW SPACE LEFT) OCTAL PAGE /****** MUST BE NO LITERALS! ****** LISHAN= 06600 /LPT: HANDLER AREA, 2 FIELD 0 PAGES DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS IFNZRO LISHAN-F0END&4000 /IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER- / RUNNING THE LPT: DEVICE HANDLER. *TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS TAD I (7746 /GET JSW AND (6777 /CLEAR BIT 2 (CAN RESTART!) CLL RAR STL RAL /SET BIT 11 (DON'T SAVE FIELD 1) DCA I (7746 /& PUT IT BACK JMS I (7607 /WRITE ERROR MESSAGES 4610 / 6 PAGES, FIELD 1 0 / FROM LOC 10000 27 / NORMAL SAVE AREA! SKP CLA JMP I INIMSG /OK, JUST EXIT TAD (JMP I RECRLF DCA XERR3 /FAILED, ASSUME WRITE LOCKED TAD (ERROR / SO NO ERROR MESSAGES ON DCA ERC15 / ERROR OR "SHOW ERRORS" JMP I INIMSG PAGE /LITERALS HERE ARE OK! /INITIALIZATION CODE--RESIDES IN BUFFER AREA AND IS WIPED / OUT DURING EXECUTION. HANDLES CHAINED AND NORMAL STARTS. START, CLA SKP /NORMAL STA /CHAINED (FROM CCL!) DCA TEMP CDF 10 DCA I (CCBB /ZAP CCB SWITCH CDF 0 TAD N200 DCA I (7745 /RESET START ADDRESS JMS INIMSG /INITIALIZE ERROR MESSAGES ISZ TEMP /CHAINED? JMP I (201 / NO, START IT UP! CDF 10 TAD I M200 /YES, 1ST OUTPUT DEVICE? CDF 0 AND (17 /(IGNORE LENGTH SPEC) SNA JMP STSWIT / NO, LEAVE AS SYS DCA DEVNO /YES, SET DEVICE NUMBER TAD DEVNO CALUSR /NOW DO HANDLER FETCH BY 1 / NUMBER (PAINTING?) STDEV, DEVHAN+1 /--2 PAGES-- JMP STERR /ARGGGG! FAILED!!! TAD STDEV DCA DEVAD /SET UP HANDLER ENTRY TAD M200 DCA DPNT /SET UP FIELD 1 POINTER TADIDP /GET NAME OF FILE DCA NAM1 TADIDP DCA NAM2 TADIDP DCA NAM3 TADIDP /GET EXTENSION DCA NAM4 TAD NAM1 /WAS THERE REALLY A NAME? SZA CLA STA / YES, SET NAME SWITCH DCA TEMP / NO, RESET CDF 10 DCA I (XDNAM /CLEAR DEVICE NAME WORDS DCA I (XDNAM+1 TAD I DPNT /GET NEXT WORD & TEST FOR ZERO SZA CLA JMP STSWIT / SOMETHING NOT RIGHT! TAD I DPNT /OK, ASSUME CCL CHAIN & SET DCA I (XDNAM / UP DEVICE NAME TAD I DPNT DCA I (XDNAM+1 TAD I (XDNAM /EMPTY? SZA CLA JMP STSWIT TAD (0423 /YES, MUST BE DEFAULT NAME-- DCA I (XDNAM / "DSK" TAD (1300 DCA I (XDNAM+1 STSWIT, CDF 10 TAD I (7643 /TEST SWITCHES AND N200 / "/E"? DCA ERMODE / 0= LONG, NON-0= SHORT IAC AND I (7643 / "/L"? [LOAD] SNA CLA JMP STSWO /NO, CHECK NEXT TAD NAM4 /YES, SET DEFAULT EXTENSION SNA TAD (1404 / TO ".LD" DCA NAM4 IAC JMP STSWEX-2 / & GO SET MODE / STSWO, TAD I (7644 AND (1000 / "/O"? [OFFSET] SNA CLA JMP STSWS /NO, GO CHECK LAST TAD I (7646 /YES, GET LOW 12 BITS OF CIA / "=NNNN" AS OFFSET AND DCA OFFSET / IT UP STA JMP STSWEX-1 / & GO SET MODE / STSWS, TAD I (7644 / "/S"? [SAVE] AND (40 SNA CLA JMP STSWEX /NO, WAS NOT ANY THAT COUNT TAD NAM4 /YES, SET DEFAULT EXTENSION SNA TAD (2326 / TO ".SV" DCA NAM4 IAC / & SET MODE DCA MODSW /-1=OFF,0=NOR,+1=SV,+2=LD STSWEX, CDF 0 ISZ TEMP /FILE NAME SPECIFIED? JMP I (201 / NO, JUST START DCA CRSWT /YES, SET SWITCH TO CR, TLS / START TTY JMS I CRLFI / & DO CR/LF TAD NAM4 /ANY EXTENSION SPECIFIED? SNA CLA STA / NO--ALLOW 3 TRIES: SV, LD, NULL DCA TEMP1 / ELSE ALLOW ONLY 1 TRY TAD NAM4 /IF NO EXTENSION SET YET, SNA TAD (2326 / SET TO START DEFAULTS WITH SV DCA NAM4 JMP XFICHN /NOW GO DO FILE LOOKUP / STERR, TLS /START UP OUTPUT JMP ERCY / & GIVE ERROR! PAGE FIELD 1 /THE END OF FIELD 0! *10000 /PUT A POINTER HERE! NXTIOT /ADDR OF NEXT FREE SPACE IN TABLE /ERROR MESSAGES AND ADDRESS LIST. THESE ITEMS RESIDE / UNDER THE USR, REQUIRING THAT THE USR SWAP THEM / WHEN IT IS USED AND THAT THE PROGRAM KICK OUT THE / USR WHEN AN ERROR OCCURS IN LONG ERROR MESSAGE MODE / OR WHEN A "SHOW ERRORS" COMMAND IS GIVEN. IT IS / TO THE ADVANTAGE OF DECTAPE (AND PROBABLY ALSO / FLOPPY DISK) SYSTEMS TO USE SHORT ERROR MESSAGE / MODE TO REDUCE USR SWAPPING IF DOING MANY "FILE" / OR "OPTION DEVICE ..." COMMANDS. *10002 /MESSAGE ADDRESS AT ERROR CODE NUMBER +1 (AUTO-XR) /LIST OF ADDRESSES OF ERROR MESSAGES ERMSA ERMSB ERMSC ERMS14 ERMSD ERMSE ERMSG ERMSH ERMSI ERMSK ERMSJ ERMSXO ERMSL ERMSZ ERMSO ERMS11 ERMS04 ERMS06 ERMSP ERMSQ ERMSR ERMS09 ERMS08 ERMS13 ERMSS ERMST ERMSU ERMSV ERMSW ERMSX ERMSY ERMS12 ERMSM ERMS00 ERMS01 ERMS02 ERMS03 ERMS10 ERMSF ERMSGC ERMSHD ERMS05 ERMS07 ERMS15 EMSEND, ERMS16 ERMS99 /ERROR MESSAGES: ERMSA, TEXT &ILLEGAL SINGLE-WORD COMMAND& ERMSB, TEXT &ILLEGAL MULTI-WORD COMMAND& ERMSC, TEXT &TOO MANY ")"S& ERMSD, TEXT &ILLEGAL FORMAT WORD& ERMSE, TEXT &BAD FORMAT SYNTAX& ERMSF, TEXT &NO FILE FOR C.C.B./HEADER REQUEST& ERMSGC, TEXT &BAD C.C.B (NOT A SAVE FILE)& ERMSHD, TEXT &BAD HEADER (NOT A LOAD MODULE)& ERMSG, TEXT &ILLEGAL ITEM TO SHOW& ERMSH, TEXT &ILLEGAL SEARCH MODIFIER& ERMSI, TEXT &BAD SEARCH SYNTAX& ERMSJ, TEXT &ILLEGAL MODE& ERMSK, TEXT &SET OPTION FOLLOWED BY A CR, BAD SYNTAX& ERMSXO, TEXT &NUMBER OR ILLEGAL SET OPTION& ERMSL, TEXT &NUMBER OR ILLEGAL OUTPUT OPTION& ERMSM, TEXT &ILLEGAL "." IN NAME (FILE OR DEVICE)& ERMSO, TEXT &ILLEGAL MODIFY FORMAT& ERMSP, TEXT &PROGRAM OR HARDWARE PROBLEM IN MODIFY COMMAND& ERMSQ, TEXT &BAD TERMINATOR IN SINGLE ARGUMENT& ERMSR, TEXT &TERMINATOR BEFORE LEGAL NUMBER INPUT& ERMSS, TEXT &BAD TERMINATOR IN MULTIPLE ARGUMENT& ERMST, TEXT &ILLEGAL CHARACTER IN EXPRESSION& ERMSU, TEXT &ILLEGAL USE OF "(" IN EXPRESSION& ERMSV, TEXT &ILLEGAL OPERATOR IN EXPRESSION& ERMSW, TEXT &TOO FEW ")"S IN EXPRESSION& ERMSX, TEXT &DIVISION BY 0 ATTEMPTED& ERMSY, TEXT &UNKNOWN HANDLER NAME& ERMSZ, TEXT &NUMBER OR ILLEGAL ERROR OPTION& ERMS01, TEXT &NON-& *.-1 ERMS00, TEXT &FATAL READ ERROR& ERMS03, TEXT &NON-& *.-1 ERMS02, TEXT &FATAL WRITE ERROR& ERMS04, TEXT &ODD START LOC OR COUNT IN OS/8 MODIFY& ERMS05, TEXT &BAD ADDRESS/OVERLAY (ODT COMMANDS)& ERMS06, TEXT &BAD FILE ADDRESS, SOMETHING DIED!& ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)& ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"& ERMS09, TEXT &ILLEGAL DIGIT& ERMS10, TEXT &LPT HANDLER ERROR& ERMS11, TEXT &NUMBER OR ILLEGAL LDEV OPTION& ERMS12, TEXT &LPT HANDLER FETCH FAILED& ERMS13, TEXT &ILLEGAL USE OF ' OR "& ERMS14, TEXT &MAPPED MODE--USE LIST, NOT DUMP& ERMS15, TEXT &NO ERROR MESSAGES& ERMS16, TEXT &INPUT ERROR ON MESSAGES& ERMS99, TEXT &DEBUG& *12000 /BEGIN ABOVE THE USR AREA /GCCB & GHDR--ROUTINES TO READ IN THE FIRST BLOCK OF THE / LAST FILE SPECIFIED BY THE LAST "FILE" COMMAND, ASSUM- / ING THAT IT WAS A SAVE FILE OR LOAD MODULE, AND DO THE / FEW CHECKS THAT ARE AVAILABLE TO TEST FOR A CCB (CORE- / CONTROL-BLOCK) OR HEADER BLOCK BEFORE LETTING THE DATA / BE USED FOR THE APPROPRIATE PURPOSE. GCCB, 0 /GET CORE-CONTROL-BLOCK JMS CCBHDR /DO COMMON TEST & READ-IN SMA CLA /1ST WORD (-# SEGS) NEG? JMP CCERR / NO, CAN'T BE CCB TAD I (CCBB+3 /GET JOB STATUS WORD AND (200 /OVERLAY BIT SET (LINK)? SZA CLA / 0 = NO TAD (CCBB+140-1 / 1 = YES, START ADDR-1 CDF 0 DCA I (OVLFLG /NO = 0; YES = ADDR-1 CDF 10 TAD I (CCBB+1 /2ND WORD A "CDF CIF X0"? AND (7707 CIA TAD CCERR SNA CLA /IF NOT, LEAVE THE AC 0 TAD I SEGNI /LOOKS OK, GET -# SEGMENTS CCERR, CDF CIF 0 SZA JMP I GCCB /OK, RETURN VALUE JMP I (GCCERR /BAD, GIVE ERROR GHDR, 0 /GET HEADER BLOCK (FORTRAN IV) TAD (3 /TO SET UP CCBB+6 JMS CCBHDR /DO COMMON TEST & READ-IN TAD (-2 /1ST WORD MUST BE EXACTLY 2 SZA CLA JMP HDERR / NO, CAN'T BE A HEADER ISZ GETSWX /1ST TIME THRU SINCE READ? JMP GHDR1 / NO, DON'T CHANGE ANYTHING DCA I (CCBB+47 /YES, BE SURE THESE WORDS DCA I (CCBB+50 / ARE 0 FOR USERS TAD I (CCBB+1 /GET START FIELD WORD SNA JMP HDERR / SHOULD BE 1 THRU 7 CLL RTL /LOOKS OK, MOVE FIELD TO BITS RAL / 6-8 TO HELP "SHOW HEAD" DCA I (CCBB+1 TAD I (CCBB+1 /ARE THESE ONLY BITS SET? AND (7707 SZA CLA JMP HDERR / NO, SOMETHING MUST BE BAD TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE SNA JMP HDERR / SHOULD BE 1 THRU 7 AND (7770 SZA CLA JMP HDERR GHDR1, DCA GETSWX /MAKE SURE THIS IS 0 CMA /AC NON-ZERO FOR OK HDERR, CDF CIF 0 SZA CLA JMP I GHDR /OK, BACK TO USER JMP I (HDRERR /BAD, GIVE ERROR CCBHDR, 0 TAD (CCBB+3 /CCBB+6 FOR GHDR CDF CIF 0 /NOTE, BOTH SET BACK! DCA I (GETPNT /SET UP POINTER FOR 'GET' TAD I (DEVAD /GET ADDR OF DEVICE DCA DEVADX / HANDLER & SAVE HERE TAD I (RBLK1 /GET START BLOCK NUMBER SNA JMP I (ERCF / NO FILE!!! GIVE ERROR CDF CIF 10 DCA GCCBLK /OK, SET UP 1ST BLOCK TAD I SEGNI /IS SOMETHING IN MEMORY? SZA JMP I CCBHDR / YES, RETURN 1ST WORD CIF 0 JMS I DEVADX /NO, READ 1ST BLOCK OF FILE 0110 /READ; 1 PAGE; FIELD 1 SEGNI, CCBB /BUFFER IS HERE GCCBLK, 0 /BLOCK NUMBER JMP RDERX /...BAD NEWS... STA DCA GETSWX /OK, SET "JUST READ" SWITCH TAD I SEGNI /AND GET 1ST WORD JMP I CCBHDR / RDERX, CDF CIF 0 /RETURN TO FIELD 0 JMP I (RERROR / FOR READ ERROR DEVADX, 0 GETSWX, 0 MSBAD, TEXT " BAD BLOCK" MSDEV, TEXT "@DEVICE = SYS@" XDNAM= .-3 /ADDR OF 1ST WORD OF DEVICE NAME /CONTINUATION OF CODE FROM FIELD 0 XDEVM, DCA XDNAM /SET 4 DEVICE NAME CHARS IN TAD I (NAM2 / OUTPUT MESSAGE DCA XDNAM+1 CDF 10 DCA I (CCBB /NO C.C.B. OR HEADER PRESENT CDF CIF 0 STA DCA I (RBLK /RESET BLOCK NUMBER JMP I (XSETN /GO DO NEXT OPTION PAGE /SYMBOLICS FOR PDP-8 INSTRUCTIONS: INSLST, TEXT "AND TAD ISZ DCA JMS JMP IOT NOP " *.-1 / GROUP 1 MICRO-INSTS.: OP1LST, TEXT "CLL CMA CML IAC BSW RAL RTL RAR RTR " *.-1 / GROUP 2 MICRO-INST'S: OP2LST, TEXT "SMA SZA SNL SKP SPA SNA SZL OSR HLT " *.-1 / EAE MICRO-INST'S: EAELST, TEXT "MQA MQL SCL MUY DVI NMI SHL ASR LSR SCA " *.-1 TEXT "DAD DST SWBADPSZDPICDCM SAM " *.-1 CLANAM, 0314 /"CLA " 0140 OPRMES, 1720 /"OPR " 2240 / IOT INSTRUCTIONS: IOTTAB, 6000 TEXT "SKON" 6001 TEXT "ION@" 6002 TEXT "IOF@" 6003 TEXT "SRQ@" 6004 TEXT "GTF@" 6005 TEXT "RTF@" 6006 TEXT "SGT@" 6007 TEXT "CAF@" 6010 TEXT "RPE@" 6011 TEXT "RSF@" 6012 TEXT "RRB@" 6014 TEXT "RCF@" 6016 TEXT "RCC@" 6020 TEXT "PCE@" 6021 TEXT "PSF@" 6022 TEXT "PCF@" 6024 TEXT "PPC@" 6026 TEXT "PLS@" 6030 TEXT "KCF@" 6031 TEXT "KSF@" 6032 TEXT "KCC@" 6034 TEXT "KRS@" 6035 TEXT "KIE@" 6036 TEXT "KRB@" 6040 TEXT "TFL@" 6041 TEXT "TSF@" 6042 TEXT "TCF@" 6044 TEXT "TPC@" 6045 TEXT "TSK@" 6046 TEXT "TLS@" 6100 TEXT "DPI@" 6101 TEXT "SMP@" 6102 TEXT "SPL@" 6103 TEXT "EPI@" 6104 TEXT "CMP@" 6105 TEXT "S,CMP" 6106 TEXT "CEP@" 6107 TEXT "SPO@" 6110 TEXT "RCTV" 6111 TEXT "RCRL" 6112 TEXT "RCRH" 6113 TEXT "RCCV" 6114 TEXT "RCGB" 6115 TEXT "RCLC" 6116 TEXT "RCCB" 6130 TEXT "CLZE" 6131 TEXT "CLSK" 6132 TEXT "CLOE" 6133 TEXT "CLAB" 6134 TEXT "CLEN" 6135 TEXT "CLSA" 6136 TEXT "CLBA" 6137 TEXT "CLCA" 6201 TEXT "CDF 00" *.-1 6211 TEXT "CDF 10" *.-1 6221 TEXT "CDF 20" *.-1 6231 TEXT "CDF 30" *.-1 6241 TEXT "CDF 40" *.-1 6251 TEXT "CDF 50" *.-1 6261 TEXT "CDF 60" *.-1 6271 TEXT "CDF 70" *.-1 6202 TEXT "CIF 00" *.-1 6212 TEXT "CIF 10" *.-1 6222 TEXT "CIF 20" *.-1 6232 TEXT "CIF 30" *.-1 6242 TEXT "CIF 40" *.-1 6252 TEXT "CIF 50" *.-1 6262 TEXT "CIF 60" *.-1 6272 TEXT "CIF 70" *.-1 6203 TEXT "CDIF00" *.-1 6213 TEXT "CDIF10" *.-1 6223 TEXT "CDIF20" *.-1 6233 TEXT "CDIF30" *.-1 6243 TEXT "CDIF40" *.-1 6253 TEXT "CDIF50" *.-1 6263 TEXT "CDIF60" *.-1 6273 TEXT "CDIF70" *.-1 6204 TEXT "CINT" 6214 TEXT "RDF@" 6224 TEXT "RIF@" 6234 TEXT "RIB@" 6244 TEXT "RMF@" 6254 TEXT "SINT" 6264 TEXT "CUF@" 6274 TEXT "SUF@" 6550 TEXT "FFST" 6551 TEXT "FPINT" 6552 TEXT "FPICL" 6553 TEXT "FPCOM" 6554 TEXT "FPHLT" 6555 TEXT "FPST" 6556 TEXT "FPRST" 6557 TEXT "FPIST" 6561 TEXT "FMODE" 6563 TEXT "FMRB" 6564 TEXT "FMRP" 6565 TEXT "FMDO" 6567 TEXT "FPEP" NXTIOT, ZBLOCK 200 /LEAVE ROOM FOR EXPANSION 0 /TABLE TERMINATOR /CODES MAY BE ADDED TO THE TABLE IN THE SPACE LEFT BY THE / "ZBLOCK 200". SINCE EACH ENTRY REQUIRES 4 WORDS (THE / ACTUAL CODE IN THE FIRST WORD AND UP TO 6 PACKED ASCII / CHARACTERS IN THE NEXT THREE WORDS, PADDED WITH TRAIL- / ING 0'S), THERE IS ROOM FOR 40 OCTAL (32 DECIMAL) IOTS / AND THEIR NAMES. THESE CAN BE PATCHED IN DIRECTLY / USING THE PROGRAM ITSELF. **** NOTE THAT THE CONTENTS / OF LOCATION 10000 POINT TO THE FIRST FREE ENTRY. **** /SYMBOLICS FOR FPP-12/8A INSTRUCTIONS MSBASE, TEXT " B+" MSINDI, TEXT "% B+" MSJNX, TEXT "JNX " /THE FOLLOWING STRINGS ARE PADDED WITH "@"S IN PROPER / PLACES TO FORCE WORD ALIGNMENT AS NEEDED. TEXT "LEA@" /+1 WORD 0000 FPPINS, TEXT "FLDA@@FADD@@FSUB@@FDIV" TEXT "FMUL@@FADDM@FSTA@@FMULM" TEXT "UNUSEDSTARTE" *.-1 FPOP00, TEXT "FNOP@@FEXIT@FPAUSEFCLA@@FNEG" TEXT "FNORM@STARTFSTARTDJAC@@" FPXR1S, TEXT "ALN ATX XTA " FPXR2S, TEXT "ADDX *,@LDX *,@" FOP134, TEXT "TRAP4 TRAP3 SETX SETB JSA @JSR " FPCOND, TEXT "EQGELEA@NELTGTAL" /CONTROL TABLES FOR FPP INSTRUCTION DECODING FPPMO0, 7 /MAJOR SUB-OP-CODE OF SPECIALS 6 5 4 3 2 1 0 /END & FALL-OUT POINT FPPMOJ, SPCOP7 SPCOP6 SPCOP5 SPCOP4 SPCOP3 SPCOP2 SPCOP1 FPPOP0, 170 /MINOR SUB-OP-CODE OF SUB-OP-CODE 160 / 0 SPECIALS 150 140 130 120 110 100 70 60 50 40 30 20 10 00 FPPOPJ, SPNUSE /ALL UNUSED POSSIBILITIES SPNUSE SPNUSE SPNUSE SPNUSE SPNUSE SPOP11 SPOP10 SPNUSE SPNUSE SPOP05 SPOP04 SPO123 SPO123 SPO123 /MESSAGES: MSERR, TEXT " ERROR CODES: FUTIL " *.-1 /VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE / VERSION NUMBER SET NEAR THE START OF THE SOURCE INTO / THE VERSION MESSAGE, USING THE ASSEMBLER RATHER THAN / FUTIL TO PRODUCE THE DESIRED OUTPUT. IT ALSO TAKES / CARE OF THE PROBLEM OF FORGETTING TO UPDATE THE VER- / SION NUMBER WHEN EDITION THE FILE. NOTE THAT FUTIL'S / OUTPUT ROUTINE WILL NOT PRINT THE "@", ALLOWING EASY / ALIGNMENT OF THE WORDS IN THE OUTPUT STRING. MSVER, TEXT "VERSION = 6@.01" VERTM1= VERSION&7000%10 /HIGH DIGIT TO BITS 3-5 VERTM2= VERSION&700%100 /LOW DIGIT TO BITS 9-11 IFNZRO VERTM1 IFZERO VERTM1 VERTM2= "0&77+VERTM2 /MAKE A DIGIT *.-4 /OVERLAY MAJOR VERSION DIGITS VERTM1 VERTM2 VERTM1= VERSION&70^10 /HIGH DIGIT TO BITS 3-5 VERTM2= VERSION&7 /LOW DIGIT TO BITS 9-11 VERTM1= "0^100+VERTM1 /MAKE INTO A DIGIT VERTM2= "0&77+VERTM2 /MAKE INTO ANOTHER DIGIT *.+1 /OVERLAY MINOR VERSION DIGITS VERTM1 VERTM2 *.+1 /SKIP OVER TERMINATOR ZERO MS01, TEXT " = " MS07, 0023 /"SMASK = " MS02, TEXT "MASK = " MS03, TEXT "ABS. LOC = " MS04, TEXT "UPPER = " MS05, TEXT "LOWER = " MS06, TEXT "FORMAT = " MS08, TEXT "DIRECTORY" MS09, TEXT "OFFSET = " MS10, TEXT "MODE = " MS11, TEXT "CCB:" MS12, TEXT "ODT LOC = " MS13, TEXT ": " MS14, TEXT " CORE SEGS: " MS15, TEXT "LOOKUP FAILED" MS16, TEXT "FPP (SYMBOLIC)" MS17, TEXT " AT " MS18, TEXT " SA = " MS19, TEXT ", JSW = " MS20, TEXT "REL. LOC = " MS21, TEXT "@PACKED " *.-1 MS22, TEXT "ASCII" MS23, TEXT "OS/8 (ASCII)" MS24, 2516 /"UNSIGNED (DECIMAL)" MS25, TEXT "SIGNED (DECIMAL)" MS26, TEXT "OCTAL" MS27, TEXT "OFFSET" MS28, TEXT "SAVE (FILE)" MS29, TEXT "NORMAL" MS30, TEXT "OUTPUT = " MS31, TEXT "PDP (SYMBOLIC)" MS32, TEXT "BLOCK = " MS33, TEXT ") " MS34, TEXT "LOAD (MODULE)" MS35, TEXT "BCD" MS36, TEXT "BYTE" MS37, TEXT "FILLER = " MS38, TEXT "HEADER:" MS39, TEXT ", NEXT WORD = " MS40, TEXT ", LOAD V " MS41, TEXT ", E.P. REQ'D" MS42, TEXT " OVLYS START BLOCK LENGTH" MS43, TEXT "COS (ASCII)" /MAIN LOOP CHARACTER LIST CCHARL, "# "$ "% "& ": "< "= "> "? "@ "[ "\ "] "/ "! "+ "- "; "^ "_ /'TYPE' COMMAND LIST TYPEL, 211 /TAB 233 /ALT MODES 375 376 /'XMODIF' CHECK LIST TYPEM, 215 /CR 212 /LF 0 /ADDRESSES FOR 'OMODES' OTABLE, BPRT /# OSTYPE /$ BYTEO /% COSOUT /& SGNDP /: OPRT /< DPRT /= PDPOUT /> DIROUT /? PDATE /@ TYPE /[ FPPOUT /\ PACOUT /] /MAIN LOOP JUMP LIST - RESPOND TO SPECIAL CHAR COPSL, OMODES OMODES OMODES OMODES OMODES OMODES OMODES /SEE ABOVE LIST OMODES OMODES OMODES OMODES OMODES OMODES SLASH EXCL PLUS MINUS SEMIC UPARR BACKAR MAIN4 ALTMOD ALTMOD ALTMOD CRCR LFLF /'TYPE' JUMP LIST TYPEOP, TYPTAB TYPALT TYPALT TYPALT TYPCR TYPCR+1 /COMMAND WORD LIST FOR COMMANDS NOT FOLLOWED BY CR CWORDL, TEXT "EVE@DUD@LIL@FIF@SCSTSMWOW@MOM@SHSES@WREX" /MAIN LOOP JUMP LIST - EXECUTE A COMMAND WOPSL, XVAL XVAL XDUMP XDUMP XLIST0 XLIST0 XFILE XFILE XSCAN XSTRIN XSMASK XWORD XWORD XMODIF XMODIF XSHOW XSET XSET XWRARG XEXIT /LISTS FOR COMMANDS FOLLOWED BY A CR. CWORL2, TEXT "REWREX" WOPSLL, XREWIN /REWIND XWRITE /WRITE XEXIT /EXIT /'XFORM' LISTS ----ORDER IS CRITICAL---- FORML, TEXT "PAP@ASA@OSOSCOC@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@" FOPSL, XFCHR /PACKED (ASCII) XFCHR XFCHR /ASCII XFCHR XFCHR /OS/8 (ASCII, PACKED) XFCHR XFCHR /COS-300 (ASCII, PACKED) XFCHR XFNUM /UNSIGNED (DECIMAL) XFNUM XFNUM /SIGNED (DECIMAL) XFNUM XFNUM /OCTAL XFNUM XFNUM /BCD XFNUM XFNUM /"BYTE (OCTAL)" XFNUM XFSYM /"PDP (SYMBOLIC)" XFSYM XFSYM /"FPP (SYMBOLIC)" XFSYM XFSYM /"DIRECTORY" XFSYM / ROUTINE ADDRESS LIST FTABLE, PACOUT TYPE OSTYPE COSOUT DPRT SGNDP OPRT BPRT BYTEO PDPDMP FPPDMP DIRDMP /'XSHFMT' DESCRIPTOR ADDRESS LIST FMTLS, MS21 /PACKED ASCII MS22 /ASCII MS23 /OS/8 ASCII MS43 /COS ASCII MS24 /UNSIGNED DECIMAL MS25 /SIGNED DECIMAL MS26 /OCTAL MS35 /BCD MS36 /BYTE MS31 /PDP SYMBOLIC MS16 /FPP SYMBOLIC MS08 /DIRECTORY /'XMODIF' COMMAND LIST MODIFL, TEXT "PAP@ASA@OSCOC@NUN@" /'XMODIF' JUMP LIST MODIFO, XPAC0 /PACKED XPAC0 XASC1 /ASCII XASC1 XOPS1 /OS/8 XCOS0 /COS XCOS0 XNUM2 /NUMERIC XNUM2 MODADS, XMOD0 /MODIFL TEST LIST XMOD0 XMOD0 XMOD0 XMOD0 XMOD0 XMOD0 XMOD0 XMOD0 MODDLS, TEXT "PAASOSCONUNUNUNUNUNUNUNU" /DEFAULT LIST /'XMODIF' CHARACTER JUMP LIST MCHARO, XMOD6 /CR, END XMOD3 /LF, IGNORE /XNUM JUMP LIST NUMOPS, XNUM1 /, ERCQ /. XNUM1+1 /SPACE XNUM3 /CR /'XSHOW' COMMAND LIST SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE" *.-1 /'XSET' COMMAND LIST OPTLST, TEXT "FOF@OUO@ERE@OFUPLODELDMOFIMAM@ /'XSHOW' JUMP LIST SHOWOP, XSHBLK /BLOCK XSHBLK XSHODL /ODT LOC XSHCCB /CCB (CORE CONTROL BLOCK) XSHCCB XSHHDR /HEADER (F4 LOAD MODULE) XSHHDR XSHABS /ABS. LOC XSHABS XSHREL /REL. LOC XSHREL XSHSMS /SMASK XSHVER /VERSION XSHFMT /FORMAT XSHFMT XSHOUT /OUTPUT XSHOUT XSHERR /ERRORS XSHERR XSHOFF /OFFSET XSHUPP /UPPER XSHLOW /LOWER XSHDEV /DEVICE ERCG /LDEV--NOT ALLOWED FOR SHOW XSHMOD /MODE XSHFIL /FILLER XSHMSK /MASK XSHMSK /'XSET' JUMP LIST OPTJMP, XFORM /FORMAT XFORM XOUTS /OUTPUT XOUTS XEMODE /ERROR (MODE) XEMODE XOFFS /OFFSET XUPP /UPPER XLOW /LOWER XDEV /DEVICE XLDEV /LDEV (LIST DEVICE) XMODE /MODE XFILL /FILLER XMASK /MASK XMASK /'XEMODE' COMMAND LIST XELST, TEXT "SHS@LOL@" /'XEMODE' BRANCH LIST XEOPS, XEMOD1 /SHORT XEMOD1 XEMOD1+1 /LONG XEMOD1+1 /'XOUTS' LISTS XOLST, TEXT "FPF@PDP@OCO@" XOOPS, XOUTS1-1 /FPP SYMBOLIC XOUTS1-1 XOUTS1 /PDP SYMBOLIC XOUTS1 XOUTS1+1 /OCTAL XOUTS1+1 /'XMODE' COMMAND LIST MODLST, TEXT "OFO@SAS@LOL@NON@" /'XMODE' JUMP LIST MODOPS, XMODS-1 /OFFSET XMODS-1 XMODS+1 /SAVE FILE XMODS+1 XMODS /LOAD MODULE XMODS XMODS+2 /NORMAL XMODS+2 /'XLDEV' LISTS XLDLST, 1420 /LP (LPT) 2424 /TT (TTY) 0 XLDOPS, XLDLPT XLDTTY /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW MODE" MS27 /-1 = "OFFSET" MODELS, MS29 / 0 = "NORMAL" MS28 /+1 = "SAVE" MS34 /+2 = "LOAD" /LIST OF DESCRIPTOR ADDRESSES FOR "SHOW OUTPUT" MS16 /-1 = "FPP (SYMBOLIC)" OUTLS, MS26 / 0 = "OCTAL" MS31 /+1 = "PDP (SYMBOLIC)" /'XWORD' COMMAND LIST XWORCL, TEXT "UNU@" *.-1 /'XSTRIN' COMMAND LIST SEALST, TEXT "FRF@TOT@ABA@MAM@ME" /'XWORD' JUMP LIST XWOROP, XWOR2 /UNEQUAL XWOR2 XWSFRM /FROM XWSFRM XWSTO /TO XWSTO XWSABS /ABSOLUTE XWSABS ERCH /MASKED--NO! XWOR7 /MEMREF XWOR7 /'XSTRIN' JUMP LIST STROPS, XWSFRM /FROM XWSFRM XWSTO /TO XWSTO XWSABS /ABSOLUTE XWSABS XSTR0 /MASKED XSTR0 ERCH /MEMREF--NO! /LIST OF TERMINATORS, IN ORDER, FOR 'EVAL' TERMS, "! /1 "& /2 "+ /3 "- /4 "/ /5 "* /6 "( /7 ") /10 215 /CR: 11 0 /'GWORD' & 'ACCEPT' COMMAND LISTS GWLST1, "9 "8 "7 "6 "5 "4 "3 "2 "1 "0 204 /^D 213 /^K "" "' "( GWLST2, 240 /SPACE 215 /CR 0 /'GWORD' JUMP LISTS GWOPS1, GWD4 / 9 - A NUMBER GWD4 / 8 - A NUMBER GWD4 / 7 - A NUMBER GWD4 / 6 - A NUMBER GWD4 / 5 - A NUMBER GWD4 / 4 - A NUMBER GWD4 / 3 - A NUMBER GWD4 / 2 - A NUMBER GWD4 / 1 - A NUMBER GWD4 / 0 - A NUMBER GWD4 /^D - A NUMBER GWD4 /^K - A NUMBER GWD4 / " - A NUMBER GWD4 / ' - A NUMBER GWD4 / ( - A NUMBER GWOPS2, GWD2 /SPACE - TERMINATOR GWD3 / CR - " /'ACCEPT' JUMP LIST ACOPS, ACCNUM / 9 - A DIGIT ACCNUM / 8 - A DIGIT ACCNUM / 7 - A DIGIT ACCNUM / 6 - A DIGIT ACCNUM / 5 - A DIGIT ACCNUM / 4 - A DIGIT ACCNUM / 3 - A DIGIT ACCNUM / 2 - A DIGIT ACCNUM / 1 - A DIGIT ACCNUM / 0 - A DIGIT CTRLD / ^D SWITCH CTRLK / ^K SWITCH DQUOTE / " - SINGLE ASCII SQUOTE / ' - PACKED ASCII ERCR / ( - ILLEGAL HERE ACCPT3-2 /SPACE - END ACCPT3-1 /CR - END /'GARGS' JUMP LIST - TERMINATORS GAROPS, GAR5 /- GAR6 /, GAR4 /. GAR3-1 /SPACE, SHOULDN'T SEE, WILL DO 'ERROR' GAR3 /CR /'GARGS' & 'ARG' COMMAND LISTS GARLST, "- ", ARGLST, ". 240 /SPACE 215 /CR 0 /'GNAME' & 'GETNT' LISTS GETOPS, GETPER GETEND GETEND+1 /'ARG' JUMP LIST ARGOPS, ARG2 ARG3 ARG3 /'WCHEK' LISTS WCKLST, "( ") "" "' 215 0 WCKOPS, WCHEK5+1 WCHEK5 WCHEK6+1 WCHEK6 WCHEK4 /'EVAL' JUMP LIST 1 EVOPS1, EVNEXT /+ EVMIN /- EVLPAR /( /'EVAL' COMMAND LISTS EVLST1, "+ "- "( 0 EVLST2, "L "B "S "C "F "R "D 0 /'EVAL' JUMP LIST 2 EVOPS2, EVLOC /L (LOC) EVBLK /B (BLK) EVSR /S (S.R.) EVSR+1 /C (CONTENTS) EVFIL /F (FILLER) EVREM /R (REMAINDER) EVDATE /D (DATE) /ERROR ROUTINE ADDRESS LIST: ERLIST, ERCA ERCB ERCC ERC14 ERCD ERCE ERCG ERCH ERCI ERCK ERCJ XSET1 ERCL ERCZ ERCO ERC11 ERC04 ERC06 ERCP ERCQ ERCR ERC09 ERC08 ERC13 ERCS ERCT ERCU ERCV ERCW ERCX ERCY ERC12 ERCM ERC00 ERC01 ERC02 ERC03 ERC10 ERCF GCCERR HDRERR ERC05 ERC07 ERC15 ERC16 0 DECIMAL SMASKB, -1 /STRING SEARCH MASK BUFFER /L(SMASKB)=66(10) COMB= SMASKB+66 /COMMAND INPUT BUFFER /L(COMB)= 140(10) PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER /**** ALSO REWIND BUFFER! **** OCTAL OUTBUF= 16400 /"LPT" OUTPUT BUFFER, 2 PAGES FIELD 1 CCBB= 17000 /CORE-CONTROL-BLOCK BUFFER AND HEADER / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1 IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1 $$$$ /L(SMASKB)=66(10) COMB= SMASKB+66 /COMMAND INPUT BUFFER /L(COMB)= 140(10) PDLB= COMB+140 /PUSH-DOWN-LIST BUFFER /**** ALSO REWIND BUFFER! **** OCTAL OUTBUF= 16400 /"LPT" OUTPUT BUFFER, 2 PAGES FIELD 1 CCBB= 17000 /CORE-CONTROL-BLOCK BUFFER AND HEADER / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1