X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape1%2Ffutil.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Fextensions%2Fdectapes%2Fdectape1%2Ffutil.pa;h=3b0b40c5738f74f1b5fed772ed163a72a56095f2;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/extensions/dectapes/dectape1/futil.pa b/sw/os8/v3d/sources/extensions/dectapes/dectape1/futil.pa new file mode 100644 index 0000000..3b0b40c --- /dev/null +++ b/sw/os8/v3d/sources/extensions/dectapes/dectape1/futil.pa @@ -0,0 +1,5746 @@ +/FUTIL - FILE UTILITY - V07A + +VERSION=07 +PATCH="A&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, XS240 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, ODT CHANGES, +/ EXIT, SCAN, WRITE LOCKED OPERATION, SPEED UP SEARCHES, +/ XS240 FORMATS +/VERSION 6.17 - APR 1, 1977; BATCH OPERATION, COMMENT +/VERSION 6.20 - MAY 16, 1977; NEW DATE, FULL FILE OUTPUT +/ (SET/SHOW DDEV, OPEN ..., CLOSE), OPT ":" ON DEVICES. +/VERSION 6.21 - JUN 4, 1977; NEW INPUT ROUTINE, TEMP STORAGE +/VERSION 6.22 - JUL 13, 1977; CRTL-Q & -S, SCOPE MODE, +/ IF/END COMMANDS, ALPHA DATE. +/ +/PREVIOUS VERSIONS HAVE BEEN AVAILABLE THROUGH DECUS, +/ DEC SUPPORT BEGINS WITH VERSION 7 - 20-JUL-77. + / 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 [VERSION 9] +/ *FUTIL 1 +DMODE, 0 /DUMP MODE: NONE=0,PART=1,ALL=4000 + +CBLK, 0 /= CURRENT BLOCK + 0 /DUMMY FOR "SHOW ABS" +CAD, 0 /= CURRENT ADDRESS (0 -> 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 + +/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 +READLN= JMS I . /GET NEXT INPUT LINE, WITH + READ / SPECIAL TERMINATORS +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 +PDATEI, PDATE +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 +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; EXEC 'COMMENT' + DCA DSWIT /RESET DUMP OUTPUT SWITCH + TAD COMST /INIT COMMAND BUFFER. + DCA COMIR + TAD (PDLB+1 /INIT PUSH-DOWN-LIST + DCA PDLPT +MAIN2, READLN /GET A LINE FROM INPUT. + CCHARL-1 /CR LF ; ! / ALT- + COPSL-CCHARL / MODES ETC... + JMP MAIN1 /BUFFER WAS EMPTIED. + + +/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 A FEW ARE OK + JMS I SORTI /NO, LOOK UP COMMAND + CWORDL-1 + WOPSL-CWORDL +ERCB, ERROR /NOT A LEGAL COMMAND +/ +CRCR1, JMS I SORTI /"WRITE","REWIND","EXIT" & "COMMENT" + 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), & (XS240 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 READLN-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 READLN-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 + +CLOSE, 0 /SUBROUTINE TO CLOSE A LOCATION + 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 + /ROUTINE TO 'EVALUATE' A SIGNED DOUBLE PRECISION ARITHMETIC +/ EXPRESSION & OUTPUT THE RESULTS IN OCTAL & D.P. SIGNED +/ DECIMAL. +XVAL, JMS I EVALI /GO EVALUATE + SKP /TERMINATED BY A CR +ERCC, ERROR / 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 + CLA /CLEAR POSSIBLE JUNK FROM AC + DCA DSWIT /RESET IN CASE DUMP MODE + 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) + CMA /= -(ADDR+1) + 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. + TAD ERMODE /LONG/SHORT MESSAGES? [NOTE: THIS -> +XERR3, SZA CLA / "7600" (A CLA) IF 'USROUT' ERROR!] + JMP XERR4 /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 +XERR4, JMS I CRLFI /OUTPUT A CR,LF PAIR + JMP I .+1 /*** CIF BAT /BATCH OPER. + MAIN1 /*** JMP I N7000 /'BATABT'! + + +USEUSR, 0 /USR CALLER SUBROUTINE (FROM EITHER FIELD!) + DCA USRSAV /SAVE CONTENTS OF AC + RDF + TAD UCDF0 /SET UP RETURN FIELD (FOR 2ND USR CALL) + DCA USRCDF +UCDF0, CDF 0 /SET TO HERE FOR 1ST CALL + 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 +USRCDF, CDF /SET UP D.F. FOR RETURN + 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 M200 + DCA XERR3 /NO MORE MESSAGES ON ERROR! + TAD ERC16 + 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 DSWIT /RESET DUMP 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 DSWIT /SET DUMP 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 XSETN +OUTSW, 0 /MODE:0=NOTHING,+=SPACES,-=CR/LF + + +PAGE + /ROUTINE TO EXECUTE THE 'OPEN' COMMAND. +XOPEN, STA /"." LEGAL IN FILE NAME + JMS GNAME /GET FILE NAME FOR OUTPUT + CIF 10 + JMP XOPEN1 /NOW GO TO FIELD 1 TO HANDLE + + +/ROUTINE TO EXECUTE THE 'CLOSE' COMMAND. +XCLOSE, CDF CIF 10 + JMP XCLOS1 /ALL CODE IS IN FIELD 1 + + +/ROUTINE TO EXECUTE THE 'FILE' COMMAND. +XFIERR, TAD TEMP1 /MADE ALL POSSIBLE ATTEMPTS + SMA CLA / AT EXTENSION RETRIES? + JMP XFIOUT / YES, ALL TRIES DONE! + 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 +/ +XFIOUT, JMS PNAME /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 GDEV2 / (NEGATIVE) & SAVE IT + TAD GDEV2 + TAD I (17 /POINT TO FIRST OF THEM + DCA GDEV3 / (THE DATE, IF PRESENT) + TAD I N7 /GET THE NUMBER OF THE + AND N7 / DIRECTORY SEGMENT IN + DCA CNTR / CORE & SAVE IT. + TAD GDEV2 /WAS # OF ADD'L WRDS = 0? + SZA CLA + TAD I GDEV3 / NO, GET THE DATE WORD + CDF 0 + DCA GDEV1 /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 GDEV3 /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 GDEV1 /GET DATE WORD + SZA /IS IT = 0? + JMS I PDATEI /NO, OUTPUT DATE + JMP XFILEN /NOW OUTPUT CR/LF & CONTINUE + + +/ROUTINE TO 'SET' THE 'DEVICE' OPTION +XDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER + DEVHAN+1 / (2 PAGE HANDLER IS OK) + DCA DEVAD /SET UP HANDLER ADDRESS + TAD GDEV2 /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 + + +/ROUTINE TO 'SET' THE 'DDEV' OPTION +XDDEV, JMS GDEVICE /GET & FETCH DEVICE HANDLER + DMPHAN+1 / (2 PAGE HANDLER IS OK) + CIF 10 + JMP XDDEV1 /GO TO FIELD 1 TO FINISH SETUP + +GDEVICE,0 /SUBROUTINE TO GET DEVICE NAME & FETCH HANDLER + JMS GNAME /GET DEV NAME ("." ILLEGAL) + TAD NAM1 /MOVE NAME TO CALL + DCA GDEV1 + TAD NAM2 + DCA GDEV2 + TAD I GDEVICE /GET HANDLER SPACE ADDRESS + ISZ GDEVICE + DCA GDEV3 + CALUSR + 1 /FETCH HANDLER +GDEV1, 0 +GDEV2, 0 +GDEV3, 0 +ERCY, ERROR /NO SUCH HANDLER + TAD GDEV3 /RETURN HANDLER ADDRESS + JMP I GDEVICE + + +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 DSWIT /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 = " + 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 XSHBKS + +XSHREL, JMS I TYPSI /"REL. LOC = " + MS20 + JMS I BKLOCI / & OUTPUT IT + BLK-1 + JMP XSHBKS + +XSHABS, JMS I TYPSI /"ABS. LOC = " + MS03 + TAD CAD /OUTPUT LOCATION IN BLOCK + TAD (-IOBUF + DCA CAD + JMS I BKLOCI + CBLK-1 +XSHBKS, TAD MODIF /HAS BLOCK BEEN MODIFIED? + SMA CLA + JMP XSHCR / NO, SAY NOTHING! + JMS I TYPSI / YES, SAY " MOD" + MSMOD + 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 + +XSHDDEV,JMS I TYPSI /"DDEV = XXXX" + MSDDEV + 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 + + +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 DSWIT /SET DUMP 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 + SETLST-1 + SETJMP-SETLST +XSET1, ERROR /WHAT??? + + +/ROUTINE TO 'SET' THE 'DMODE' (DUMP MODE) +XDMODE, JMS I GWORDI /GET A WORD + JMP ERC11 /NO NUMBERS HERE! + JMS I SORTI /LOOK IT UP + XDMLST-1 + XDMOPS-XDMLST +ERC11, ERROR /NO LIKEE!! +/ + CLL STA RAR /4000: 'ALL' (ECHO TO TTY & FILE) +XDMODS, IAC / 1: 'PART' (ONLY DUMP,LIST,ETC) + DCA DMODE / 0: 'NONE' (TTY ONLY) + JMP XSETN + + +/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 XSETN + + +/ROUTINE TO 'SET' THE 'MASK' OPTION +XMASK, JMS I ARGI /GET ONE ARG + TAD ACC1 /GET 'LOC' + DCA MASK / & SET MASK + JMP XSETN + + +/ROUTINE TO 'SET' THE 'OFFSET' OPTION +XOFFS, JMS I ARGI /GET ONE ARG + TAD ACC1 /GET # + CIA + DCA OFFSET /SET IT + JMP XSETN + + +/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 XSETN + + +/ROUTINE TO 'SET' THE 'UPPER' LIMITS OPTION +XUPP, JMS I LIMITI /UPPER, GET ARGS + UBLK + JMP XSETN + +/ROUTINE TO 'SET' THE 'LOWER' LIMITS OPTION +XLOW, JMS I LIMITI /LOWER, GET ARGS + LBLK + JMP XSETN + +/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 XSETN + +/ROUTINE TO 'SET' THE 'FILLER' OPTION +XFILL, JMS I ARGI /GET ONE ARG + TAD ACC1 + DCA FILLER / & SET AS FILLER + JMP XSETN + +/ROUTINE TO 'SET' THE 'TEMP' STORAGE +XTEMP, JMS I ARGI /GET THE 24 BIT ARG (EXPRESSION!) + TAD ACC1 /NOW SAVE THE 24 BITS FOR LATER + DCA TEMPV1 + TAD ACC2 /GET IT BACK WITH "EVAL T" + DCA TEMPV2 / (OR IN AN EXPRESSION) + JMP XSETN + + +/ROUTINE TO EXECUTE THE 'IF' COMMAND +XIF, JMS I EVALI /EVALUATE THE EXPRESSION + SKP / TERMIN = CR, OK + JMP ERCC / TOO MANY PARENS + TAD ACC1 /TEST THE 24-BIT VALUE FOR ZERO + SNA + TAD ACC2 + SNA CLA + JMP I RESTAR /OK, JUST CONTINUE +XIFSKP, TAD COMST /NOT ZERO, BEGIN SKIPPING FOR + DCA COMIR / LINE STARTING WITH "END" + READLN /GET A LINE FROM THE INPUT + TYPEM-1 / WITH THESE TERMINATORS + IFSKPO-TYPEM + JMP XIFSKP /BUFFER EMPTIED +/ +XIFCR, JMS I ENDCI /CR FOUND, TIDY THINGS UP + JMP XIFSKP / CR ONLY + JMS I GWORDI /GET 1ST WORD ON LINE + JMP XIFSKP / NO WORD + TAD (-0516 /IS THE WORD "EN..."? + SZA CLA + JMP XIFSKP / NO, KEEP LOOKING! + JMP I RESTAR /YES! BEGIN EXECUTION AGAIN! + + +/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 + JMP ERCP / 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 + + +ASCII, 0 /ASCII OUTPUT FORMAT FROM DEVICE + AND N177 /MAKE CHARS INTO "STANDARD" + TAD N200 / FORM: 7 BITS + PARITY ON + JMS I TYPEI / TO CAUSE CORRECT PRINTING + JMP I ASCII + + +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, + STRLST-1 / AB, FR, TO + STROPS-STRLST + 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 ERCP /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 XMODEF /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! +/ +/NO FORMAT DESCRIPTOR GIVEN, USE DEFAULT +XMODEF, 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 +/ +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 + READLN /GET A LINE (TEST: RUBOUT, ^U & ^R) + TYPEM-1 /IGNORE LF'S + MCHARO-TYPEM + JMP XMOD2 /BUFFER EMPTIED! + + +/CR TYPED, END +XMODCR, 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) + +XMODDN, 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 + GETLST-1-1 /SPACE, COMMA, CR + NUMOPS-GETLST+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 XMODDN /YES, TEST NEXT SET +/ +XNUM3, TAD CNTR /DONE? + SNA CLA + JMP XMODDN /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 XMODDN /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 XMODDN /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 + + +DO1SP, 0 /OUTPUT " " + AC + JMS I TYPECI + " + JMP I DO1SP /ANOTHER TUFFIE + +DO2SP, 0 /OUTPUT " " + AC (PACKED ASCII) + JMS I TWOCI + 4040 + JMP I DO2SP /FAST & SWEET! + + +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 + + +/XS240 PACKED ASCII FORMAT HERE +XXS20, 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 CGET /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 XMODDN /YES, TEST FOR DONE +XOPS4, JMS CGET /GET & TEST NEXT CHAR + JMP XOPS2 /OK, DO NEXT +/ +XOPS5, JMS XGET /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 XMODDN /YES +/ +PACK1, JMS I RTL6I /LEFT HALF, ROTATE INTO IT + DCA CHARSW /SAVE IT + JMS XGET /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 + + +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 + + +/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 PNAME / & SAVE IT + JMS I ARGI /GET COMMAND DATA + TAD TEMP1 /GET BLOCK NUMBER PART + ISZ TEMP1 /WAS A BLOCK PART SPEC'D? + DCA I PNAME / YES, STORE IT + CLA /(CLEAR IN CASE NOT!) + ISZ PNAME /BUMP POINTER + TAD ACC2 + AND N7 + DCA I PNAME /STORE HIGH 3 BITS + ISZ PNAME + TAD ACC1 + DCA I PNAME / & LOW 12 BITS OF ADDR. + JMP I LIMITS + + +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 # + DCA RBLK + DCA MODIF / AND RESET SWITCH + TAD CBLK /SHOW BLOCK NUMBER IN LIGHTS + MQL / (IF THERE ARE ANY!) + CLA + 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 I PDATEI /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 + TAD (4 / YES, RESET POINTER + DCA GETPNT / TO SKIP OVER LVL 0 + 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 + JMS I (ASCII /OUTPUT CHARS TO "STANDARD" + 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 /ENTER HERE TO INITIALIZE + 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 /JUMP HERE IF 2ND CHAR TO GET + 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 'XOPEN', 'XFILE', 'XDEV' & 'XDDEV' + +GNAME, 0 /GET A FILE OR DEVICE NAME + DCA TEMP1 /SET UP "." SWITCH AND + TAD TEMP1 / FILE/DEVICE SWITCH + DCA TEMP2 + 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 + STA + TAD COMOUT /BACK UP THE POINTER + DCA COMOUT + JMS GPAIR /1ST & 2ND CHAR + JMS GPAIR /3RD & 4TH +GETSCN, JMS GPAIR /5TH & 6TH OR 1ST & 2ND EXT. + JMS GETNT /SCAN FOR TERMINATOR + CLA + JMP .-2 +/ +GETCOL, TAD TEMP2 /":" SEEN, DEVICE OR FILE NAME? + SZA CLA + JMP GETNTC / FILE, JUST USE THE ":" + ISZ TEMP2 / DEVICE, FLAG ":" SEEN + JMP GETSCN+1 / AND SCAN TO TERMIN. +/ +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 + GETLST-1 + GETOPS-GETLST +GETNTC, TAD CHAR /OK, USE CHAR + AND N77 /MASK TO 6 BITS + JMP I GETNT / & EXIT WITH IT + +GPAIR, 0 /GET RIGHT/LEFT-HALF-CHARS + JMS GETNT + JMS I RTL6I /TO LEFT HALF + DCA I TEMP / & STORE IT + JMS GETNT + TAD I TEMP /MERGE WITH LAST LEFT + DCA I TEMP + ISZ TEMP /BUMP POINTER + JMP I GPAIR + +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 READ A "LINE" FROM THE USER. IT CHECKS FOR +/ RUBOUT, ^U AND ^R FIRST, THEN CHECKS FOR ONE OF A LIST OF +/ TERMINATORS PASSED BY THE CALLER. AS WITH OS/8, RUBOUT +/ DELETES CHARACTES AND ^U DELETES THE CURRENT LINE. ^R +/ (FOR RETYPE) ECHOES THE CURRENT COMMAND BUFFER IN THE SAME +/ MANNER AS LINE-FEED DOES FOR OS/8. IF THE CHARACTER IS A +/ TERMINATOR, CONTROL PASSES DIRECTLY TO THE CORRESPONDING +/ CALLER ROUTINE (OUT OF THIS ROUTINE). INPUT CHARACTERS +/ ARE ALSO TRANSLATED FROM LOWER CASE TO UPPER CASE. EXIT +/ IN THE NORMAL MANNER OCCURS ONLY ON BUFFER EMPTY FROM +/ RUBOUT OR ^U. + +READ, 0 /READ AND ECHO INPUT CHARACTER + TAD I READ /GET TWO LIST ADDRESS PARAMETERS + ISZ READ + DCA RETERM / FROM CALLER AND SET UP IN + TAD I READ / SORT ROUTINE CALL + ISZ READ + DCA RETERM+1 +RENEXT, JMS RKEY /GET A CHAR + JMP RUBO /RUBOUT, GO BEGIN DELETIONS +REKEY, DCA CHAR + JMS I SORTI /CHECK FOR CTRL-R & CTRL-U + REACTL-1 + REACTS-REACTL + TAD CHAR + JMS I TYPEI + JMS I SORTI /CHECK FOR CALLER TERMINATORS +RETERM, 0 / PARAMETERS HERE + 0 + TAD CHAR /NONE, JUST STORE IN BUFFER + SKP +RESPC, TAD (" /FOR CAMMAND INPUT, TAB -> SPACE! + CDF 10 + DCA I COMIR /COMMAND (LINE) INPUT BUFFER + CDF 0 + JMP RENEXT +/ +/+++ FOR SCOPE OPERATION, RUBOUTS CAUSE OUTPUT OF THE +/+++ SEQUENCE BACKSPACE, SPACE, BACKSPACE TO CLEAR THE +/+++ PREVIOUS CHARACTER FROM THE SCREEN. IF "SCOPE +/+++ MODE" IS SET, RUBO IS OVERLAID ON STARTUP. + +/*** FOR BATCH OPERATION, RUBOUTS ARE IGNORED BY 'RKEY' +/*** AND 'RUBO' IS OVERLAID WITH CODE TO IGNORE A LINE- +/*** FEED THAT FOLLOWS A CARRIAGE-RETURN. +/ +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 ENDC + CDF 10 + TAD I ENDC + 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 THE CHAR + JMS I TYPECI / 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 RENEXT /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 /*** JMS I CTRLI /CHECK KEYBOARD + JMP .-1 /*** CIF BAT /BATCH OPER. + JMS I CTRLI /*** JMS I BATINI + KSF /*** ERROR /EOF!! + JMP RKEY+1 /*** NOP /MUST USE SPECIAL CARE + KRB /*** NOP / TO HANDLE CTRL-Q! + AND N177 /MASK OFF PARITY + SNA + JMP RKEY+1 /NULL CHAR + TAD (-177 /IS IT A RUBOUT? + SNA +RKEY0, JMP I RKEY /YES, EXIT TO CALL+1 /*** BATCH + ISZ RKEY /NO, EXIT TO CALL+2 /*** OPER. + 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 + + +/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 (215 /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 + + +DODIG, 0 /OUTPUT AC AS AN ASCII DIGIT + JMS I TYPECI + "0 + JMP I DODIG + + +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 + PDATE, 0 /ROUTINE TO OUTPUT AN EXTENDED DATE WORD + DCA CRLF /SAVE IT + TAD CRLF /GET WORD & MASK + AND N377 + CLL RTR /DAY (4-8) TO 7-11 + RAR + JMS I DEC2I / OUTPUT AS 2 DIGITS (MASKED) + JMS I TYPECI / AND A SEPARATOR + "- + TAD CRLF /GET WORD A SECOND TIME + JMS I RTR6I /MONTH (0-3) TO 7-10 + RAR / FOR MONTH*2 + AND (36 / MASK IT AND USE AS AN INDEX + JMS I TYPSI / TO OUTPUT MONTH IN ALPHA + MONTHS / FORM (WITH SAFETY...) + JMS I TYPECI /FOLLOWED BY "-" + "- + TAD CRLF /GET LAST TIME + AND N7 / MASK OFF YEAR + TAD YRTEST / TEST IF .GT. THIS YEAR + SMA SZA + TAD (-10 / YES, SUBTRACT 8 + TAD YRBASE / ADD TO BASE YEAR + JMS I DEC2I / & OUTPUT IT + JMP I PDATE +YRTEST, 0 /-(THIS YEAR) FOR TESTING +YRBASE, 0 /BASE YEAR FOR DATE + THIS YEAR + + +TYPEA, 0 /OUTPUT ASCII CHARACTER IN THE AC + TAD I TYPEA /GET ARG, IF ANY + ISZ TYPEA + DCA I RTL6I /SAVE THE CHAR HERE FOR FIELD 1 + JMS I CTRLI + CIF 10 + JMP TYPE1 /GO TO FIELD 1 TO DO THE OUTPUT +/ +TYPEX, ISZ NCNT /BUMP LINE POSITION + JMP I TYPEA / & EXIT + +CRLF, 0 /OUTPUT CARRIAGE RETURN, LINE FEED + CLA + JMS TYPEA + 215 + JMS TYPEA + 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 TYPEA /NOW OUTPUT CHAR +TCHAR, 0 + JMP I TYPE +/ +TYPALT, JMS TYPEA /OUTPUT "$" FOR ALT-MODES + "$ + JMP I TYPE +/ +TYPCR, JMS CRLF /C.R. TO OUTPUT + JMP I TYPE +/ +TYPTAB, JMS TYPEA /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 TYPEA /CONTROL-CHAR, OUTPUT AS + "^ + TAD C100 / "^","CHAR+100" + JMP TYPC +C100, 100 + + +CTRL, 0 /CHECK FOR CTRL-C, CTRL-S, CTRL-Q & CTRL-P + DCA CTRLQS /CLEAR HANG FLAG +CTRL0, KSF /HAS A KEY BEEN HIT? + JMP CTRLX /NO, TEST IF HANGING + KRS + AND N177 /YES, MASK OFF PARITY BIT + TAD (-"C+300 /IS IT A CTRL-C (ABORT PROGRAM)? + SNA +BCTRLC, JMP CTRLC /*** JMP I CTRLCI /== ABORT == + TAD M20 /IS IT A CTRL-S (STOP OUTPUT)? + SZA + JMP CTRL1 + ISZ CTRLQS / YES, SET HANG FLAG + KCC / & CLEAR HARDWARE FLAG +CTRL1, TAD (2 /IS IT A CTRL-Q (START OUTPUT)? + SZA + JMP CTRL2 + KCC / YES, CLEAR THE HARDWARE + JMP I CTRL / & JUST EXIT +/ +CTRL2, IAC /IS IT A CTRL-P (STOP PROGRAM)? + SZA CLA + JMP CTRLX /NO, TEST IF HANGING + KCC + DCA DSWIT /YES, RESET DUMP SWITCH + JMS I TYPECI /OUTPUT "^P" + "P-100 + JMP I RECRLF / THEN CR/LF & RESTART +/ +/ROUTINE TO EXECUTE THE 'EXIT' COMMAND +/ +XEXIT, +CTRLC, DCA DSWIT /RESET DUMP SWITCH + JMP I M200 / & GO TO SYSTEM +CTRLCI, XERR4+1 /*** CTRL-C ABORTS JOB STREAM! *** +/ +CTRLX, TAD CTRLQS /HANGING BECAUSE OF CTRL-S? + SZA CLA + JMP CTRL0 / YES, BACK FOR ANOTHER ROUND + JMP I CTRL / NO, OUT WE GO! + +CTRLQS, 0 /CTRL-S, CTRL-Q FLAG + + +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 + + +XS240O, 0 /XS240 FORMAT PACKED ASCII + JMS I RTR6I /HIGH 6 BITS + AND N77 + SPACE1 / PLUS A SPACE + TADICAD /THEN LOW 6 BITS, + AND N77 + SPACE1 / PLUS A SPACE + JMP I XS240O + + +GETN, 0 /GET NEXT CHAR FROM COMM. BUFF. + CDF 10 + TAD I COMOUT + CDF 0 + DCA CHAR + JMP I GETN + + +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 EVALX /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 +EVTEMP, TAD TEMPV1 /"T" -- USE 'TEMP' STORAGE + DCA ACC1 + TAD TEMPV2 + 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 +ERCW, ERROR /TERM = CR, NOT ENOUGH PARENS + POP + DCA EVAL /RESTORE RETURN ADDR + POP + DCA LASTOP /RESTORE LASTOP +EVOPN, JMS I TERMTI /GET NEXT & TEST FOR TERM. + JMP EVAL2 /OK + JMP EVPAR2-1 /GARBAGE, GIVE SAME ERROR + +EVALX, TAD CNTRA /WAS CHAR CR OR ")"? + TAD M10 + SNA CLA + ISZ EVAL / ")", RETURN TO CALL+2 + JMP I EVAL / CR, RETURN TO CALL+1 + +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 +ERC08, ERROR /CR = 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 + RESPC+1 +/ +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 + DMPHAN-F0END /(SHOW SPACE LEFT) + + OCTAL + +PAGE /****** MUST BE NO LITERALS! ****** + +DMPHAN= 06600 /DUMP HANDLER AREA, 2 FIELD 0 PAGES + +DEVHAN= 07200 /DEVICE HANDLER AREA, 2 FIELD 0 PGS + + +IFNZRO DMPHAN-F0END&4000 + +/IF THE ABOVE ASSEMBLES, THE BUFFERS ARE OVER- +/ RUNNING THE DUMP DEVICE HANDLER. + + +*TEMPL /ADD INITIALIZATION CODE WHICH IS OVERLAID + +INIMSG, 0 /INITIALIZE ERROR MESSAGES ON SCRATCH BLKS + CDF 10 + TAD I (7726 /BUT FIRST CHECK FOR "SCOPE MODE" + CDF 0 + AND N200 / (BIT 4 OF 17726) + SNA CLA + JMP INIDAT / NOT SET, GO SET UP DATE +INISCO, TAD I SPNT /SET, CHANGE RUBOUT HANDLER TO + SNA + JMP INIDAT / ERASE CHARACTERS FROM SCREEN + DCA I DPNT / AND FROM BUFFER (MUCH EASIER + JMP INISCO / THAN ON HARD COPY!) +/ +INIDAT, CDF 10 /NOW INIT EXTENDED DATE + TAD I (7666 /GET SYSTEM DATE WORD + CDF 0 + AND N7 /PICK OFF THIS YEAR PART + CIA + DCA YRTEST / AND SET TEST YEAR (NEG) + TAD I M1 /NOW GET EXTENDED YEAR BITS + AND (600 / FROM "B.I.P." WORD AND + CLL RTR / MOVE TO BITS 7,8 (*8) + RTR + TAD (106 /ADD TO A STARTING BASE OF 70[10] + CIA + TAD YRTEST /AND ADD THIS YEAR ALSO + CIA + DCA YRBASE /= 70 + EXTEND*8 + THIS YEAR + 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 M200 + 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 /INIT SCOPE, DATE & ERROR MESSAGES + JMS BATSET /TEST & SET UP FOR BATCH + 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, +STTLS, TLS / START TTY *** BATCH OPER. + 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 *** BATCH OPER. + JMP ERCY / & GIVE ERROR! + + +PAGE + /INITIALIZATION CODE FOR BATCH OPERATION + +BATSET, 0 + TAD I M1 /TEST BIT 1 OF 07777 FOR "BIP" + RAL / (BATCH-IN-PROGRESS) + SMA CLA + JMP I BATSET / NO, INTERACTIVE MODE + TAD I M1 / YES, GET FIELD BITS OF BATCH + AND (70 / TO GENERATE A "CIF BAT" + TAD (CIF / AND SET UP 3 CALLS: + DCA CBATI / INPUT, + TAD CBATI + DCA CBATO / OUTPUT AND + TAD CBATI + DCA CBATE / ERROR. +BATMOV, TAD I SCANX1 /GET NEXT STORAGE ADDRESS + SNA + JMP I BATSET / 0 = ALL DONE! + DCA DPNT /SET UP POINTER +BATLUP, TAD I SCANX1 /GET A PATCH WORD + SNA + JMP BATMOV / 0 = GROUP END +BATPAT, CDF 0 /CHANGED FOR "TYPEB"!! + DCA I DPNT /PATCH THE WORD + CDF 0 + JMP BATLUP /DO IT AGAIN! + + +/"SCOPE MODE" PATCHES FOR RUBOUT HANDLER. INITIAL- +/ IZATION CODE FIRST CHECKS FOR SCOPE AND THEN FOR +/ BATCH. THUS, IF BOTH ARE SET, FIRST THINGS WILL BE +/ SET UP FOR SCOPE AND THEN THEY WILL BE RESET FOR +/ BATCH. THIS SEQUENCE IS REQUIRED! + +SCOPLS, RELOC RUBO + JMS BTEST /BUFFER NOW EMPTY? + JMP RENEXT / YES, JUST IGNORE RUBOUT + STA + TAD COMIR /NO, BACK UP POINTER + DCA COMIR + TAD COMIR /SET UP POINTER FOR TESTING, ALSO + DCA COMOUT + JMS RUBO2 /OUTPUT BACKSPACE, SPACE, BACKSPACE + JMS I GETNI /GET RUBBED OUT CHAR AND TEST + TAD CHAR + TAD M240 / FOR A CONTROL CHAR + SPA CLA + JMS RUBO2 /YES, ERASE "^" ALSO! + JMP RENEXT /TRY FOR ANOTHER CHAR + +RUBO2, HLT /MUST BE NON-ZERO!!! + JMS I TYPEAI /OUTPUT A BACKSPACE, + "H-100 /(CTRL-H) + SPACE1 / SPACE, + JMS I TYPEAI / BACKSPACE SEQUENCE TO + "H-100 / CLEAR OFF SCREEN CHAR + JMP I RUBO2 +TYPEAI, TYPEA + 0 + + RELOC + + +BATLS, /PATCHES--ADDRESS-1, CODE, 0 WITH EXTRA 0 FOR END. + + RUBO-1 /==== INPUT PATCHES ==== + RELOC RUBO + DCA CHAR /SAVE NEW CHAR INPUT + TAD CHAR /IS THIS A FORM-FEED? + TAD RM214 + SNA + JMP RKEY+1 / YES, JUST IGNORE IT! + TAD R2 /NO, THEN IS IT A LINE-FEED? + SNA CLA + TAD RLAST / YES, WAS LAST A CARRIAGE-RETURN? + TAD M215 + SZA CLA + TAD CHAR /NO TO ONE OR OTHER, USE CHAR. + DCA RLAST / YES TO BOTH, SET TO 0! + TAD RLAST /OK, WAS IT A CR-LF PAIR? + SNA CLA + JMP RKEY+1 / YES, JUST IGNORE LF! + JMP REKEY+1 / NO, GO USE THIS CHAR + +BATINI, 5400 /IN THE BATCH FIELD +RM214, -214 +R2, 2 +RLAST, 215 /!!! CR OF ".R FUTIL" HAS AN LF !! + 0 + + RKEY+1-1 + RELOC /TO PUT 'CBATI' ON THIS PAGE +CBATI= .+1 /REALLY ON "CIF BAT" + RELOC RKEY+1 + JMS I CTRLI /CHECK FOR CONTROL KEYS + CIF /*** CIF BAT + JMS I BATINI /GET A BATCH CHARACTER +ERC17, ERROR /!!! EOF ON INPUT !!! + NOP /FILLER FOR INTERACTIVE CTRL-Q + NOP + 0 + + RKEY0-1 + RELOC RKEY0 + JMP RKEY+1 /IGNORE RUBOUT UNDER BATCH + NOP / & RETURN TO CALL+1! + 0 + + BCTRLC-1 + RELOC BCTRLC + JMP I CTRLCI /CTRL-C, ABORT JOB STREAM! + 0 + + RELOC /==== OUTPUT PATCHES ==== + 201-1 + NOP + 0 + + STTLS-1 + NOP /ZAP 3 "TLS"S USED FOR STARTUP + 0 + + STERR-1 + NOP + 0 + + RELOC /==== ERROR PATCH ==== + + XERR4-1 +CBATE= . /REALLY ON "CIF BAT" + RELOC XERR4 + CIF /*** CIF BAT + JMP I N7000 /ABORT TO BATCH FIELD! + 0 + + RELOC + + BATPAT-1 + CDF 10 /*** NEXT CODE IN FIELD 1 *** + 0 + + TYPEB-1 + RELOC +CBATO= .+1 /REALLY ON "CIF BAT" + IFDEF TYPEB + CDF 10 /*** SET UP RETURN D.F. + CIF /*** CIF BAT + JMS I .+1 /OUTPUT A CHARACTER TO LOG + 7400 /BATOUT, IN THE BATCH FIELD + CDF 0 /*** RESET D.F. + 0 + + RELOC + + 0 + + +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 "SET DEVICE ...DDEV..." 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 + ERMSP + ERMSQ + ERMSR + ERMS09 + ERMS08 + ERMS13 + ERMSS + ERMST + ERMSU + ERMSV + ERMSW + ERMSX + ERMSY + ERMSM + ERMS00 + ERMS01 + ERMS02 + ERMS03 + ERMS10 + ERMSF + ERMSGC + ERMSHD + ERMS05 + ERMS07 + ERMS18 + ERMS19 + ERMS20 + ERMS15 + ERMS16 +EMSEND, ERMS17 + 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& + +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, + +ERMS07, TEXT &BAD ADDRESS/OVERLAY (MODIFY)& + +ERMS08, TEXT &ARGUMENT EXPRESSION NOT TERMINATED BY ")"& + +ERMS09, TEXT &ILLEGAL DIGIT& + +ERMS10, TEXT &DUMP HANDLER ERROR& + +ERMS11, TEXT &NUMBER OR ILLEGAL DMODE OPTION& + +/ERMS12, + +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& + +ERMS17, TEXT &EOF ON BATCH INPUT& + +ERMS18, TEXT &ENTER FAILED& + +ERMS19, TEXT &CLOSE FAILED& + +ERMS20, TEXT &DUMP FILE OVERRUN& + +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 GCCERR / 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 GCCCDF + SZA CLA +GCCERR, JMS ERROR1 /LOOKS BAD, JUST EXIT NOW! + ISZ GETSWX /LOOKS OK, 1ST TIME SINCE READ? + JMP GCCB2 /NO, DON'T CHANGE THINGS AGAIN + TAD (CCBB+140+3 /YES, POINT TO LENGTH WORDS +GCCB1, DCA GHDR / TO CHANGE PAGES TO BLOCKS + TAD I GHDR /GET A WORD - PAGES + SNA + JMP GCCB2 / 0 = DONE + IAC /ROUND DOWN IN 2 STEPS FOR PDP-8 + CLL RAR + DCA I GHDR /STORE A WORD - BLOCKS + TAD GHDR /UPDATE POINTER TO NEXT + TAD (4 + JMP GCCB1 +/ +GCCB2, DCA GETSWX /BE SURE SWITCH STAYS CLEAR + TAD I SEGNI /GET -# SEGMENTS +GCCCDF, CDF CIF 0 + JMP I GCCB /OK, RETURN VALUE + +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 HDRERR / 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 HDRERR / 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 HDRERR / NO, SOMETHING MUST BE BAD + TAD I (CCBB+3 /OK, TEST FIELD OF NEXT FREE + SNA + JMP HDRERR / SHOULD BE 1 THRU 7 + AND (7770 + SZA CLA +HDRERR, JMS ERROR1 +GHDR1, DCA GETSWX /MAKE SURE THIS IS 0 + CMA /AC NON-ZERO FOR OK + CDF CIF 0 + JMP I GHDR /OK, BACK TO USER + +CCBHDR, 0 + TAD (CCBB+3 /CCBB+6 FOR GHDR + CDF 0 + 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 +ERCF, JMS ERROR1 / NO FILE!!! GIVE ERROR + CDF 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 + + +MSMOD, TEXT " MOD" + +MSBAD, TEXT " BAD BLOCK" + + +PAGE + /CONTINUATION OF OUTPUT COMMANDS AND ROUTINES FROM FIELD 0 + +/CONTINUATION OF 'SET' 'DDEV' HANDLER + +XDDEV1, DCA DDEVAD /SET UP HANDLER ADDRESS + TAD I (GDEV2 + DCA DDEVNO / AND DEVICE NUMBER + CDF 10 + TAD DDEVNO /LOOK AT DCW FOR SPECIFIED + TAD (7760-1 / DEVICE TO SEE IF FILE + DCA DDCWPT / STRUCTURED. + TAD I DDCWPT /BIT 0 = 1 FOR FILES + SMA CLA + TAD (212 / NO, LINE-AT-A-TIME + DCA DDEVS / YES, BLOCK-AT-A-TIME + TAD DMPADR /OK, INITIALIZE OUTPUT POINTER + DCA DMPPTR + DCA XOSIZ / AND ZERO BLOCK COUNTER + DCA DNAM / AND CLEAR ANY FILE NAME + IAC + DCA DMPBLK / AND SET BLOCK NUMBER TO 1 + JMP XDDEV2 /LAST, GO SET UP NAME FOR OUTPUT + + +/CONTINUATION OF EXECUTION OF 'OPEN' COMMAND + +XOPEN1, TAD (NAM1-1 /SET UP POINTER TO FIELD 0 FILE + DCA DPNT / NAME (NOTE: XR IN FIELD 1!!!) + TAD I DPNT /MOVE THE FILE NAME UP HERE + DCA DNAM + TAD I DPNT + DCA DNAM+1 + TAD I DPNT + DCA DNAM+2 + TAD I DPNT /GET THE EXTENSION PART + ISZ I (TEMP1 / WAS ANYTHING REALLY SPECIFIED? + JMP XOPEN2 + CLA + TAD (0425 / NO, DEFAULT TO ".DU" +XOPEN2, DCA DNAM+3 + TAD XCLNAM /SET UP POINTER TO NAME FOR USR + DCA XOBLK + CDF 10 /SET UP RETURN FIELD + TAD I DDCWPT /CLEAR ANY OPEN FILE ON + AND (7770 / THIS DEVICE SO "OPEN" + DCA I DDCWPT / CAN BE DONE WHENEVER! + CIF 0 /SET UP SUBROUTINE FIELD + TAD DDEVNO /GET DUMP DEVICE NUMBER + JMS USEUSR / AND GO GET USR & CALL IT. + 3 /ENTER +XOBLK, 0 /NAME POINTER, BECOMES START BLK +XOSIZ, 0 / BECOMES -# BLOCKS CAN USE +ERC18, JMS ERROR1 /THE ENTER FAILED! + TAD XOBLK /OK! SET UP FILE START BLOCK + DCA DMPBLK + TAD DMPADR /INITIALIZE POINTER + DCA DMPPTR +XOCEX, CDF CIF 0 + JMP MAIN1 /TRY NEXT COMMAND + +DDEVAD, 7607 /INIT ADDRESS TO "SYS:" (SEE ABOVE) +DDEVNO, 1 /INIT THIS TO "SYS:" ALSO. +DDCWPT, 7760 / THIS ALSO + +DNAM, 0 /DUMP FILE NAME, INIT TO NULL + 0 + 0 + 0 /(EXTENSION HERE) + + +/CONTINUATION OF EXECUTION OF 'CLOSE' COMMAND + +XCLOS1, TAD DNAM /IS ANY FILE OPEN? + SNA CLA + JMP XOCEX / NO, IGNORE COMMAND + TAD XCTLZ / YES, OUTPUT A CTRL-Z + JMS DMPOUT / AND FILL TO END +XCTLZ, "Z-100 + TAD XOBLK /OK, CALCULATE FILE SIZE + CIA + TAD DMPBLK /= NEXT - START + DCA XCLSIZ /= FILE SIZE IN BLOCKS + TAD DDEVNO /GET DUMP DEVICE NUMBER + CIF 0 + JMS USEUSR /GET USR AND CALL IT + 4 /CLOSE +XCLNAM, DNAM /POINTER TO FILE NAME +XCLSIZ, 0 /SIZE OF NEW FILE +ERC19, JMS ERROR1 /OH NO! CLOSE FAILED! + DCA DNAM /OK, ZAP KNOWLEDGE OF FILE + JMP XOCEX + + +DMPOUT, 0 /DUMP FILE CHARACTER OUTPUT ROUTINE + DCA DMPCHR /SAVE THE CHARACTER + TAD DMPCHR /PUT IT INTO FILE BUFFER + CDF 10 /(MUST BE SURE!) +DMPNUL, DCA I DMPPTR /INSERT AN 8 BIT CHAR + ISZ DMPPTR + TAD DMPPTR /NOW AT END OF BUFFER? + TAD (-DMPBUF-400 + SNA CLA + JMP DMPIT / YES, DUMP BUFFER NOW + TAD DMPCHR /NO, FILL FOLLOWING THIS CHAR? + CIA + TAD I DMPOUT /(THE TEST CHAR @ CALL+1) + SNA CLA + JMP DMPNUL / YES, FILL WITH NULLS! + JMP I DMPOUT / NO, EXECUTE FILL CHAR +/ +DMPIT, CIF 0 + JMS I DDEVAD /CALL DUMP FILE HANDLER + 4210 /WRITE, 2 PAGES, FIELD 1 +DMPADR, DMPBUF +DMPBLK, 1 /BLOCK NUMBER +ERC10, JMS ERROR1 /ERROR ON OUTPUT FILE! + TAD DMPADR /NOW RESET OUTPUT POINTER + DCA DMPPTR + ISZ DMPBLK /INCREMENT BLOCK NUMBER + ISZ XOSIZ /ANY MORE SPACE LEFT? + JMP I DMPOUT / YES, EXIT NOW + DCA DNAM / NO! ZAP DUMP FILE +ERC20, JMS ERROR1 / AND DIE! +DMPCHR, 0 +DMPPTR, 0 /CHARACTER OUTPUT POINTER + + +PAGE + /CONTINUATION OF ROUTINE TO OUTPUT A CHAR TO A DEVICE + +TYPE1, TAD I (DMODE /TTY= NONE, PART&-DSWIT, ALL + AND I (DSWIT / SO TEST FOR PART&DSWIT + SZA CLA + JMP TYPE2 /NO OUTPUT TO TTY + TAD I (RTL6 /GET CHARACTER TO OUTPUT +TYPEB, NOP /*** CDF 10 /*** BATCH + TSF /*** CIF BAT /*** CHANGES + JMP .-1 /*** JMS I .+1 /*** LOG + TLS /*** 7400 /*** OUTPUT + CLA /*** CDF 0 +TYPE2, STL CLA RAR /=4000 (SET AC BIT 0 FOR TEST) + TAD I (DSWIT /=4000 OR 4001 (DSWIT=1) + AND I (DMODE /FILE= PART&DSWIT OR ALL + SNA CLA + JMP TYPE3 / OUTPUT TO TTY ONLY + TAD DDEVS /FILE STRUCTURED OUTPUT? + CDF 10 + SNA + TAD I (DNAM / YES, FILE OPEN? + CDF 0 + SNA CLA + JMP TYPE3 / NO TO EITHER + TAD I (RTL6 /OK, GET CHARACTER TO OUTPUT + JMS DMPOUT /OUTPUT IT & TEST FOR END +DDEVS, 0 /TEST: 0=FILE, 212= NON-FILE +TYPE3, CDF CIF 0 + JMP TYPEX /BACK AND OUT + + +ERROR1, 0 /FIELD 1 ERROR ROUTINE HEAD + CLA /CLEAR POSSIBLE JUNK IN AC + TAD ERROR1 /MOVE RETURN ADDR TO FIELD 0 + CDF CIF 0 + DCA I (XERROR + JMP I (XERROR+1 + + +XDDEV2, CDF 0 /NAME IS OVER THERE + TAD I (NAM1 /MOVE DEVICE NAME INTO STRING + DCA XDDNAM / IN THIS FIELD FOR "SHOW DDEV" + TAD I (NAM2 + DCA XDDNAM+1 + CDF CIF 0 + JMP XSETN /BACK TO 'SET' + +MSDDEV, TEXT "@DDEV = SYS@" +XDDNAM= .-3 + +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 XSETN /GO DO NEXT OPTION + + +MSERR, TEXT " ERROR CODES: FUTIL " + *.-1 + +/VERSION NUMBER MESSAGE--THE FOLLOWING CODE INSERTS THE +/ VERSION NUMBER AND PATCH LEVEL SET NEAR THE START OF +/ THE SOURCE INTO THE VERSION MESSAGE. + +MSVER, TEXT "VERSION = ???" /VERS = 2 DIGITS, PATCH = 1 + *.-2 +VERTEN= VERSION%12 /TENS DIGIT +VERONE= -VERTEN^12+VERSION /ONES DIGIT + VERTEN^100+VERONE+6060 /INSERT TWO DIGITS + PATCH^100 /INSERT PATCH + NULL TERM + +/ALPHA MONTH NAMES PLUS DUMMIES FOR PDATE SUBROUTINE + +MONTHS, TEXT " 00@JAN@FEB@MAR@APR@MAY@JUN@JUL" + TEXT "AUG@SEP@OCT@NOV@DEC@ 13@ 14@ 15" + + +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: + +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" + +MS17, TEXT " AT " + +MS18, TEXT " SA = " + +MS19, TEXT ", JSW = " + +MS20, TEXT "REL. LOC = " + +MS21, TEXT "PACKED" + +MS22, TEXT "ASCII" + +MS23, TEXT "OS/8" + +MS24, 2516 /"UNSIGNED" + +MS25, TEXT "SIGNED" + +MS26, TEXT "OCTAL" + +MS27, TEXT "OFFSET" + +MS28, TEXT "SAVE" + +MS29, TEXT "NORMAL" + +MS30, TEXT "OUTPUT = " + +MS31, TEXT "PDP" + +MS32, TEXT "BLOCK = " + +MS33, TEXT ") " + +MS34, TEXT "LOAD" + +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 "XS240" + /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 /% + XS240O /& + SGNDP /: + OPRT /< + DPRT /= + PDPOUT /> + DIROUT /? + PDATE /@ + ASCII /[ + 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 + RESPC + 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@OPSCSTSMWOW@MOM@SHSES@WRIFEXCOC@" + +/MAIN LOOP JUMP LIST - EXECUTE A COMMAND +WOPSL, XVAL + XVAL + XDUMP + XDUMP + XLIST0 + XLIST0 + XFILE + XFILE + XOPEN + XSCAN + XSTRIN + XSMASK + XWORD + XWORD + XMODIF + XMODIF + XSHOW + XSET + XSET + XWRARG + XIF + XEXIT + MAIN1 /COMMENT + MAIN1 + +/LISTS FOR COMMANDS FOLLOWED BY A CR. +CWORL2, TEXT "REWRENEXCLCOC@" + +WOPSLL, XREWIN /REWIND + XWRITE /WRITE + MAIN1 /END + XEXIT /EXIT + XCLOSE /CLOSE + MAIN1 /COMMENT + MAIN1 + /'XFORM' LISTS ----ORDER IS CRITICAL---- +FORML, TEXT "PAP@ASA@OSOSXSX@UNU@SIS@OCO@BCB@BYBYPDPDFPF@DID@" + +FOPSL, XFCHR /PACKED (ASCII) + XFCHR + XFCHR /ASCII + XFCHR + XFCHR /OS/8 (ASCII, PACKED) + XFCHR + XFCHR /XS240 (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 + ASCII + OSTYPE + XS240O + DPRT + SGNDP + OPRT + BPRT + BYTEO + PDPDMP + FPPDMP + DIRDMP + +/'XSHFMT' DESCRIPTOR ADDRESS LIST +FMTLS, MS21 /PACKED ASCII + MS22 /ASCII + MS23 /OS/8 ASCII + MS43 /XS240 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@OSXSNUN@" + +/'XMODIF' JUMP LIST +MODIFO, XPAC0 /PACKED + XPAC0 + XASC1 /ASCII + XASC1 + XOPS1 /OS/8 + XXS20 /XS240 + XNUM2 /NUMERIC + XNUM2 + +MODADS, XMOD0 /MODIFL TEST LIST + XMOD0 + XMOD0 + XMOD0 + XMOD0 + XMOD0 + XMOD0 + XMOD0 + XMOD0 + +MODDLS, TEXT "PAASOSXSNUNUNUNUNUNUNUNU" /DEFAULT LIST + +/'XMODIF' CHARACTER JUMP LIST +MCHARO, XMODCR /CR, END + RENEXT /LF, IGNORE + +/'XIF' CHARACTER JUMP LIST +IFSKPO, XIFCR /CR, END OF LINE + RENEXT /LF, IGNORE + +/XNUM JUMP LIST +NUMOPS, XNUM1 /, + ERCQ /: + ERCQ /. + XNUM1+1 /SPACE + XNUM3 /CR + /'XSHOW' COMMAND LIST +SHOWL, TEXT "BLB@ODCCC@HEH@ABA@RER@SMVE" + *.-1 +/'XSET' COMMAND LIST +SETLST, TEXT "DDFOF@OUO@ERE@OFUPLOTEDEDMMOFIMAM@ + +/'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 + XSHDDEV /DDEV + XSHFMT /FORMAT + XSHFMT + XSHOUT /OUTPUT + XSHOUT + XSHERR /ERRORS + XSHERR + XSHOFF /OFFSET + XSHUPP /UPPER + XSHLOW /LOWER + ERCG /TEMP--NOT ALLOWED FOR SHOW + XSHDEV /DEVICE + ERCG /DMODE--NOT ALLOWED FOR SHOW + XSHMOD /MODE + XSHFIL /FILLER + XSHMSK /MASK + XSHMSK + +/'XSET' JUMP LIST +SETJMP, XDDEV /DDEV (DUMP DEVICE) + XFORM /FORMAT + XFORM + XOUTS /OUTPUT + XOUTS + XEMODE /ERROR (MODE) + XEMODE + XOFFS /OFFSET + XUPP /UPPER + XLOW /LOWER + XTEMP /TEMP + XDEV /DEVICE + XDMODE /DMODE (DUMP MODE) + 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 + +/'XDMODE' LISTS +XDMLST, TEXT "ALPANO" + +XDMOPS, XDMODS-1 /ALL + XDMODS /PART + XDMODS+1 /NONE + + +/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 +STRLST, 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 /, + ERCS /:, SHOULDN'T SEE, WILL DO ERROR + GAR4 /. + ERCS /SPACE, SHOULDN'T SEE, WILL DO 'ERROR' + GAR3 /CR + +/'GARGS' & 'ARG' COMMAND LISTS +GARLST, "- + ", +GETLST, ": +ARGLST, ". + 240 /SPACE + 215 /CR + 0 + +/'GETNT' LISTS +GETOPS, GETCOL + 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 + "T + "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) + EVTEMP /T (TEMP) + EVDATE /D (DATE) + +/ACTION CHARS FOR "READLN" SUBROUTINE +REACTL, "R-100 /CTRL-R = RE-ECHO + "U-100 /CTRL-U = ERASE LINE + 0 + +REACTS, RECHO + RERASE + /ERROR ROUTINE ADDRESS LIST: + +ERLIST, ERCA + ERCB + ERCC + ERC14 + ERCD + ERCE + ERCG + ERCH + ERCI + ERCK + ERCJ + XSET1 + ERCL + ERCZ + ERCO + ERC11 + ERC04 + ERCP + ERCQ + ERCR + ERC09 + ERC08 + ERC13 + ERCS + ERCT + ERCU + ERCV + ERCW + ERCX + ERCY + ERCM + ERC00 + ERC01 + ERC02 + ERC03 + ERC10 + ERCF + GCCERR + HDRERR + ERC05 + ERC07 + ERC18 + ERC19 + ERC20 + ERC15 + ERC16 + ERC17 + 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! **** + CCBB-PDLB /SHOW PDL SPACE + + OCTAL + + +CCBB= 16400 /CORE-CONTROL-BLOCK BUFFER AND HEADER + / BUFFER FOR LOAD MODULES, 1 PAGE FIELD 1 + +DMPBUF= 16600 /DUMP OUTPUT BUFFER, 2 PAGES FIELD 1 + +IOBUF= 17200 /DEVICE I/O DUFFER, 2 PAGES FIELD 1 + + +$$$$ +