File FUTIL.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/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<FUTIL/L/K/P=6400$ / .SA ... FUTIL / / THE LISTING FILE REQUIRES ABOUT 725 BLOCKS, THE BIN- / ARY FILE ABOUT 35 BLOCKS AND THE CREF LISTING FILE ABOUT / 960 BLOCKS. CREFING REQUIRES EITHER "/M" OR "/X" FOR / CREF V3. /MEMORY ALLOCATION: / /00000-06310 PROGRAM PROPER /06310-06577 ARGUMENT STRING BUFFER /06400-06777 --- ONCE ONLY CODE FOR CHAIN --- /06600-07177 DDEV HANDLER AREA, 2 PAGES /07200-07577 DEVICE HANDLER AREA, 2 PAGES / /10000-11777 USR AREA & ERROR MESSAGES (SWAPPED) /12000-12377 CCB/HEADER CODE, OPEN, CLOSE & OUTPUT /12600-15700 TEXT STRINGS, LISTS /15700-16377 STRING MASK, COMMAND BUFFERS, PDL /16400-16577 CCB BUFFER, 1 PAGE /16600-17177 DDEV BUFFER, 2 PAGES /17200-17577 I/O BUFFER, 2 PAGES
/PAGE 0: POINTERS, CONSTANTS, VARIABLES, SWITCHES, ADDRESSES *0 OVLFLG, 0 /OVERLAY FLAG FOR SAVE FILES DPSGN, 0 LASTOP, 0 THISOP, 0 ZBLOCK 3 /USED BY ODT /VARIABLES & SWITCHES PDLPT, 0 /P.D.L. POINTER DPNT, RUBO-1 /USED UNIVERSALLY (SCOPE INITIALIZATION) SPNT, SCOPLS-1 /USED BY 'XSTRIN', 'XSMASK', 'READ', 'TERMT' SCANX1, BATLS-1 /USED BY 'SORTJ' (BATCH INITIALIZATION) SCANX2, 0 /USED BY 'XSTRIN' GETPNT, 0 /USED BY 'GET' & 'BKLOC' COMIR, 0 /USED FOR USER LINE INPUT COMOUT, COMB-1 /USED FOR USER LINE SCAN TYPSW, 0 /ODT COMMAND OCT-SYM SWITCH (0=OCT) ERMODE, 0 /ERROR MESSAGE MODE SWITCH (0=LONG) TEMP, 0 TEMP1, 0 TEMP2, 0 TEMP3, 0 ACC1, 0 /24 BIT ACCUMULATORS ACC2, 0 ACCX1, 0 ACCX2, 0 NAM1= ACC1 /DEFINITIONS FOR NAME BUFFER: NAM2= ACC1+1 / THESE LOCATIONS ARE USED FOR A NAM3= ACC1+2 / 6 CHARACTER FILE (OR DEVICE) NAM4= ACC1+3 / NAME & A 2 CHAR EXTENSION. OPER1, 0 OPER2, 0 TEMPV1, 0 /24 BIT TEMPORARY STORAGE FOR TEMPV2, 0 / "SET TEMP ..." & "EVAL T" CHAR, 0 CNT, 0 CNTR, 0 CNTRA, 0 NCNT, 0 /LINE POSITION COUNTER FCNT, 0 /FORMAT NUMBER (INIT TO PACKED ASCII) OUTPNT, PACOUT /POINTER TO DEFAULT OUTPUT ROUTINE MODSW, 0 /MODES: NORMAL=0,MAPPED=+,OFFSET=-. CHARSW, 0 /CHARACTER PACK & UNPACK SWITCH CRSWT, 0 /= -1 IF GWORD TERMINATOR WAS A SPACE SHUT, 0 /= -1 IF SOMETHING OPEN MODIF, 0 /= -1 IF SOMETHING WAS MODIFIED ABSSW, 0 /ABSOLUTE OR RELATIVE LOCATION FOR SEARCHES DSWIT, 0 /DUMP SWITCH: "DUMP","LIST" & "SHOW ERR" -> 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 = <VERSION><PATCH>" 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 <BADERR,__CAN'T RUN> /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 </NO PASS1 ERROR! RELOC TYPEB /*** REALLY IN FIELD 1 *** > 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 $$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search