Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
dump.mac
There are 7 other files named dump.mac in the archive. Click here to see a list.
00010 TITLE DUMP - PROGRAM TO DUMP ARBITRARY FILES IN PRINTABLE FORMAT
00020 SUBTTL DON BLACK/DAL - VERSION 4 - 12 AUGUST 1972
00030 ;COPYRIGHT (C) 1974,1978,1979 BY
00040
00050 ;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
00060 ;
00070 ;
00080 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
00090 ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
00100 ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
00110 ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
00120 ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
00130 ;TRANSFERRED.
00140 ;
00150 ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
00160 ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
00170 ;CORPORATION.
00180 ;
00190 ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
00200 ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
00205
00210 VWHO==0 ;WHO LAST EDITED THIS PROGRAM
00220 VDUMP==4 ;VERSION OF DUMP
00230 VPATCH==0 ;PATCH LETTER
00240 VEDIT==232 ;EDIT NUMBER
00250
00260 LOC 137
00270 BYTE (3)VWHO(9)VDUMP(6)VPATCH(18)VEDIT
00280 XALL
00290 TWOSEG
00300 RELOC 400000
00310
00320 ;AC'S
00330
00340 SF=0 ;SCANER FLAGS
00350 T1=1 ;TEMP AC'S
00360 T2=2 ; ..
00370 T3=3 ; ..
00380 T4=4 ; ..
00390 P1=5 ;PRESERVED AC'S
00400 P2=6 ; ..
00410 N=7 ;HOLDS A NUMBER
00420 C=10 ;HOLD A CHARACTOR
00430 M=11 ;MESSAGE POINTER
00440 F=12 ;FLAGS
00450 FM=13 ;SCAN STORES MASKS IN HERE
00460 DL=14 ;ANOTHER WORD OF FLAGS (NONE SET BY COMMAND SCANER)
00470 P=17 ;PUSH DOWN POINTER
00480
00490 ;I/O CHANNELS
00500
00510 IC==6 ;INPUT FILE
00520 OC==7 ;OUTPUT CHANNEL
00530
00540 ;EXTERNALS IN COMMAND SCANNER
00550
00560 EXTERNAL .FILIN,.GTSPC,.ISCAN,.MKPJN,.POPJ1,.SAVE2,.SAVE4
00570 EXTERNAL .SIXSW,.TIALT,.TIAUC,.VSCAN,E.UKK
00580 EXTERNAL .SWDPB,.NAME
00590
00600 SEARCH C,SCNMAC
00010 SUBTTL LOADING INSTRUCTIONS
00020
00030 REPEAT 0,<
00040
00050 IF YOU HAVE MACRO 47:
00060
00070 .R PIP
00080 *T.MAC=TTY:
00090 %.C==-3
00100 ^Z
00110 .LOAD T.MAC+<C.MAC,SCNMAC.MAC>,DUMP.MAC,SCAN.REL,HELPER.REL
00120
00130 IF YOU HAVE MACRO 50 (OR LATER):
00140
00150 .LOAD C.UNV+SCNMAC.UNV+DUMP.MAC,SCAN.REL,HELPER.REL
00160
00170 >
00010 SUBTTL REVISION HISTORY
00020
00030 ;EDITS 2 THRU 157 IN NO SPECIAL ORDER:
00040 ;
00050 ;A) AC'S WERE CHANGED AS FOLLOWS:
00060 ; F WAS MOVED FROM 7 TO 12
00070 ; V WAS ELIMINATED
00080 ; N WAS MOVED FROM 14 TO 7
00090 ; M WAS MOVED FROM 15 TO 11
00100 ; C WAS MOVED FROM 16 TO 10
00110 ; FM WAS ADDED AS 13
00120 ; DL WAS ADDED AS 14
00130 ;
00140 ;B) ASCII AND SIXBIT OUTPUT MODES WERE REDEFINED AS FOLLOWS:
00150 ; ASCII IS A SINGLE RIGHT JUSTIFIED CHARACTER IF
00160 ; BITS 0 TO 28 ARE ALL ZERO. IT IS 5 LEFT JUSTIFIED
00170 ; CHARACTERS IF BITS 0 TO 28 ARE NON-ZERO. CONTROL
00180 ; CHARACTERS PRINT AS BLANKS.
00190 ; SIXBIT IS A SINGLE RIGHT ADJUSTED CHARACTER IF BITS 0
00200 ; TO 29 ARE ZERO. IF BITS 0 TO 29 ARE NOT ZERO
00210 ; IT IS TREATED AS 6 SIXBIT CHARACTERS.
00220 ;
00230 ;C) THE TDUMP COMMAND HAS BEEN IMPLEMENTED TO DUMP TO BOTH TTY: AND
00240 ; OUTPUT FILE.
00250 ;
00260 ;D) DEFINITION OF DOUBLE QUOTE HAS BEEN CORRECTED. IT WAS DEFINED AS
00270 ; 41 SHOULD BE 42.
00280 ;
00290 ;E) MACRO DEFINITIONS WERE MOVED FROM DUMP.MAC TO SCNMAC.MAC.
00300 ;
00310 ;F) THE FOLLOWING SINGLE LETTERS WERE MADE TO MATCH COMMANDS:
00320 ; D IS UNIQUE FOR DUMP
00330 ; I INPUT
00340 ; M MODE
00350 ; O OUTPUT
00360 ; T TDUMP
00370 ;
00380 ;G) TABLES AND CALLS WERE MODIFIED TO USE SCAN NOT SCANNER.
00390 ;
00400 ;H) A TABLE OF ABSENT DEFAULTS WAS BUILT FOR PRE-SETTING SWITCHES.
00410 ;
00420 ;I) THE FOLLOWING BUILT IN SYMBOLS HAVE BEEN CREATED:
00430 ; . THE ADDRESS OF THE LAST WORD TYPED OUT.
00440 ; $ THE LAST BYTE TYPED OUT
00450 ; % THE LAST VALUE THE EXPRESSION EVALUATOR RETURNED.
00460 ;
00470 ;J) DUMP NOW LOOKS FOR CCL FILES IN TMPCOR PRIOR TO LOOKING ON DISK.
00480 ;
00490 ;K) SCAN IS USED INSTEAD OF SCANNER
00010 ;L) THE /TYPE SWITCH APPLIES TO EACH INPUT FILE SPECIFIED (INPUT
00020 ; FILE AND SYMBOL FILE)
00030 ;
00040 ;M) NUMBERS WERE CHANGED TO SYMBOLIC DEFINITIONS. SOME SYMBOLS
00050 ; ARE DEFINED IN C.MAC.
00060 ;
00070 ;N) THE TITLE COMMAND WAS MADE TO WORK
00080 ;
00090 ;O) POOR AND NON-WORKING CODE USED FOR STORING LISTS WAS CORRECTED.
00100 ;
00110 ;P) THE INPUT CHARACTER AC (C) HAS THE FOLLOWING POSSIBLE STATES:
00120 ; -2 END OF FILE
00130 ; -1 END OF LINE (LF-VT-FF)
00140 ; 0 ESCAPE
00150 ; 1-177 ASCII CHARACTER
00160 ;
00170 ;Q) A CASE WHERE DUMP WOULD LOOP FOREVER HAS BEEN CORRECTED. THIS WAS
00180 ; CAUSED BY THE INDEX OVERFLOWING.
00190 ;
00200 ;R) WIDTH, JUSTIFY, AND MODE LISTS WERE IMPLEMENTED.
00210 ;
00220 ;S) SPECIAL PATTERNS IN STRINGS NOW WORK CORRECTLY.
00230 ;
00240 ;T) QUOTED STRINGS NOW WORK CORRECTLY. THE FOLLOWING FIXES WERE INVOLVED:
00250 ; 1) END OF LINE GETS YOU OUT OF QUOTED STRING MODE.
00260 ; 2) ; HAS NO EFFECT IN A QUOTED STRING
00270 ; 3) MULTIPLE SPACES AND TABS ARE PRESERVED
00280 ;
00290 ;U) " HAS BEEN ADDED AS AN OPERATOR MEANING TAKE THE LEFT HALF WORD
00300 ; AND MOVE IT TO THE RIGHT HALF EXTENDING THE SIGN BIT.
00310 ;
00320 ;V) CPOPJ HAS BEEN CHANGED TO .POPJ AND CPOPJ1 HAS BEEN CHANGED TO
00330 ; .POPJ1. BOTH ROUTINES HAVE BEEN MOVED TO SCAN.
00340 ;
00350 ;W) THE NUMERIC INPUT ROUTINE HAS BEEN FIXED TO WORK FOR NUMBER WHICH
00360 ; FILL ALL 36 BITS. PRIOR TO THIS FIX 777777777777(8) WAS
00370 ; CHANGED TO 377777777777(8) DURING OCTAL INPUT
00380 ;
00390 ;X) THE INPUT ROUTINES WERE CONVERTED TO READ A SYMBOL FILE.
00400 ;
00410 ;Y) FULL SUB-FILE DIRECTORY SUPPORT HAS BEEN ADDED.
00420 ;
00430 ;Z) JOBDAT SYMBOLS HAVE BEEN CHANGED FROM JOBXXX TO .JBXXX
00010 ;AA) THE FILE READING ROUTINES READ THE FIRST BLOCK OF
00020 ; THE FILE. PRIOR TO THIS FIX IF THE FIRST WORD OF THE FILE
00030 ; WAS REQUESTED THE READ-IN ROUTINES WOULD THINK THE BLOCK
00040 ; WAS IN CORE AND RETURN ZERO.
00050 ;
00060 ;BB) THE OUTPUT FORMATTER HAS BEEN REWRITTEN TO FIX SEVERAL BUGS. IN ADDITION
00070 ; THE FOLLOWING EXTERNAL CHANGES HAVE BEEN MADE:
00080 ; 1 "WORD NOT IN FILE" PRINTS INSTEAD OF "\\\\".
00090 ; 2. NEGATIVE ADDRESSES LIST AS SUCH.
00100 ; 3 AFTER ATTEMPTING TO PRINT NXM A REFERANCE
00110 ; TO AN EXISTANT LOCATION MUST BE MADE TO TURN PRINTING
00120 ; BACK ON.
00130 ; 4 RADIX 50 IS NOW A SUPPORTED MODE
00140 ; 5 OCTAL NOW PRINTS IN FIXED FORMAT OF XXXXXX,XXXXXX
00150 ; 6 A LINE IS NEVER SPLIT BETWEEN THE MINUS SIGN AND
00160 ; THE NUMBER.
00170 ; 7 LOCATIONS MAY BE PRINTED OUT AS SYMBOLIC INSTRUCTIONS.
00180 ;
00190 ;CC) NEGATIVE NUMBERS PRINT OUT AS -NUMBER AND NOT A SEQUENCE OF SPECIAL
00200 ; CHARACTERS.
00210 ;
00220 ;DD) ADDRESS ARE NOW FOLLOWED BY /<TAB> NOT /<SPACE>
00230 ;
00240 ;EE) THE SYFILE COMMAND SPECIFIES A FILE FOR A SYMBOL TABLE.
00250 ;
00260 ;FF) THE XTRACT COMMAND READS THE SYMBOL FILE LOOKING FOR DDT'S
00270 ; SYMBOL TABLE POINTER AND EXTRACTING THE SYMBOL TABLE.
00280 ;
00290 ;GG) SYMBOLS ARE NOW ACCEPTED ON TYPE-IN. IF THE SYMBOL IS
00300 ; MULTIPLY DEFINED IT MUST BE PRECEDED BY A PROGRAM NAME.
00310 ; E.G. DUMP:EXPSYM
00320 ;
00330 ;HH) SYMBOLS ARE AVAILABLE FOR TYPE OUT IN SYMBOLIC INSTRUCTIONS.
00340 ;
00350 ;II) A PERMUTATION VECTOR IS COMPUTED FOR THE SYMBOL TABLE. THIS ALLOWS
00360 ; A BINARY SEARCH OF THE SYMBOL TABLE WHEN LOOKING FOR A SYMBOL
00370 ; MATCHING A VALUE.
00380 ;
00010 ;EDITS NOT SPECIFICALY LISTED ARE PART OF THE EDIT NUMBER PRIOR TO
00020 ; THEM. E.G. EDIT CLOSED OUT IN MIDDLE TO RELOAD THE MONITOR
00030 ; USES 2 EDIT NUMBERS. THE EDIT NUMBER IS INCREMENTED EVERY
00040 ; TIME THE FILE IS EDITED.
00050
00060 ;EDITS AFTER 157:
00070
00080 ;160) ADD REVISION HISTORY
00090
00100 ;161) FIX LCHR TO HANDLE <TAB> CORRECTLY. PRIOR TO THIS EDIT IT
00110 ; CONSIDERED <TAB> A SINGLE PRINT POSITION.
00120
00130 ;162) MAKE 20 THRU 24 ILLEGAL IN A LISTING FILE. ONLY END OF LINE
00140 ; NOW VALID ARE FORM FEED, LINE FEED AND VERTICAL TAB.
00150
00160 ;163) MAKE FNDADR RETURN NXM IF ADDRESS IS NEGATIVE
00170
00180 ;164) REMOVE JUNK AFTER THE NOT IN FILE MESSAGE
00190
00200 ;165) SCAN SYMBOL TABLE FOR OPCODES AFTER TRYING BUILT
00210 ; IN TABLE
00220
00230 ;166) RELOAD T1 AFTER CALL TO VAL2SY IF WE WANT NUMERIC OUTPUT.
00240
00250 ;167) DO NOT OUTPUT NULLS
00260
00270 ;170) REMOVE LOC/ FROM BLANK LINES.
00280
00290 ;171) CLEAN UP LISTING
00300
00310 ;172) IMPROVE FNDDAE TO:
00320 ; 1. RETURN NXM IF ADDRESS IS .GT. 777777
00330 ; 2. RETURN NXM IF ADDRESS IS BETWEEN LOW AND HIGH SEGS
00340 ; 3. REMEMBER FIRST 200 WORDS OF CORE IMAGE
00350
00360 ;173) MORE OF 172
00370
00380 ;174) ADD CODE TO MAKE LOOKING FOR A DAEMON CATEGORY INDEPENDENT
00390 ; OF THE ORDER IN WHICH THE CATEGORIES ARE WRITTEN
00400
00410 ;200) CLEANUP NXM MESSAGE, FIX BAD LOGIC, RANDOM FIXES
00420 ; TO THE LISTING.
00430
00440
00450 ;203) AC'S DO NOT CONTAIN THE RIGHT VALUES. BUFFER IS REMEMBERED FROM
00460 ; SYMBOL FILE WHICH IS NOT RIGHT. FIX: DO NOT LOAD BUFFER DURING
00470 ; XTRACT COMMAND.
00480
00490 ;204) ILL MEM REF AT CMPRED CAUSED BY CALLING CMPRED WRONG. FIX:
00500 ; CALL CORRECTLY AND FIX THE COMMENTS ON CMPRED.
00010 ;205) PART OF LISTING MISSING. ADD A LIST PSEUDO-OP
00020
00030 ;206) THE PRESENT DEFAULTS HAVE BEEN CHANGED FOR SEVERAL
00040 ; COMMANDS. THE NEW PRESENT DEFAULTS ARE:
00050 ; ADDRESS ON
00060 ; AUTOFORMAT ON
00070 ; NUMPAGE 1
00080 ; NOTE: A PRESENT DEFAULT IS THE DEFAULT WHEN
00090 ; THE SWITCH IS GIVEN WITHOUT AN ARGUMENT.
00100
00110 ;207) INPUT, OUTPUT, SYFILE ETC. WITHOUT AN ARGUMENT
00120 ; ARE NOW IGNORED. PRIO TO THIS EDIT THEY
00130 ; CAUSED A HALT.
00140
00150 ;210) THE CLOSE COMMAND NOW CLEARS THE FILE OPEN BIT. IT
00160 ; ALSO FORCES APPEND MODE.
00170
00180 ;211) THE ALL COMMAND CAN NOW BE TERMINATED BY AN <ESC>
00190
00200 ;212) FIX .HGH AND .SHR FILES TO DUMP CORRECTLY. THIS INVOLVES
00210 ; STARTING THE /ALL SWITCH AT THE RIGHT PLACE AND MAKING
00220 ; ALL ADDRESSES BELOW THE HISEG NXM.
00230
00240 ;214) " OPERATOR GIVEN MORE PRECEDENCE. ALSO HRL CHANGED
00250 ; TO HLR AS INTENDED.
00260
00270 ;215) DATRED NOW LOOKS FOR ERRORS
00280
00290 ;216) SOMETIMES THE NUMBERS DO NOT LINE UP. CRLF GETS OUTPUT
00300 ; IN PAD FIELD. CURE: SEE IF CRLF NEEDED AND
00310 ; PUT OUT FIRST IF IT IS REQUIRED AT ALL.
00320
00330 ;217) IF AN INPUT COMMAND IS GIVEN PRIOR TO A SYFILE
00340 ; COMMAND THE INPUT FILE NAME IS USED AS THE
00350 ; DEFAULT FOR XTRACT.
00360
00370 ;220) 1B0 DOES NOT GET OUTPUT CORRECTLY. FIX: MAKE RADIX
00380 ; PRINTER ADD ONE SO MOVM WILL RETURN
00390 ; A POSITIVE NUMBER.
00400
00410 ;221) TITLES DO NOT WORK QUITE RIGHT. FIX: MAKE THE
00420 ; SPECIAL PATTERN <FF> CALL NEWPAG.
00430
00440 ;222) CALL OSCAN TO READ USER SPECIFIC DEFAULTS. THIS IS A FILE
00450 ; IN THE USERS AREA CALLED SWITCH.INI WHICH CONTAINS A LIST
00460 ; OF SWITCHES ON A LINE BEGINING WITH DUMP:
00470
00480 ;223) IGNORE SPACES NEXT TO &
00010
00020 ;224) IF A LINE ENDS IN THE MIDDLE OF A QUOTED STRING ^? SOMETIMES
00030 ; GETS PRINTED. FIX: TEST FOR END OF LINE MORE OFTEN.
00040 ; ***NOTE: A WELL FORMED STRING MUST END WITH A QUOTE.
00050
00060 ;225) CALLI'S DO NOT PRINT CORRECTLY. FIX: ADD DEVSTS TO TABLE.
00070
00080 ;226) IF AN I/O ERROR TOOK PLACE ON A CLOSE COMMAND USER GOT THE WRONG
00090 ; ERROR MESSAGE. FIX: TEST RIGHT HALF OF STATUS
00100
00110 ;227) ANY FILE WHICH IS LESS THAN 8 BLOCKS LONG AND IS NOT IN COMPRESSED
00120 ; FORMAT LOOKED ZERO WHEN THE FIRST WORD WAS EXAMINED. FIX: LOAD
00130 ; T1 WITH WORD FROM BUFFER PRIOR TO LOOKING FOR ERRORS. IF AN
00140 ; ERROR TOOK PLACE IT WILL NOT CAUSE WRONG TYPEOUT.
00150
00160 ;230) THE XTRACT COMMAND DID NOT WORK CORRECTLY WITH MORE THAN 1 INPUT
00170 ; FILE. FIX: ADD CURRENT SIZE OF SYMBOL TABLE WHEN ASKING FOR
00180 ; CORE.
00190
00200 ;231) LEFTMARGIN WORKS ON TTY: NOT ON LPT:. DIAGNOSIS: LINE FEED COMES
00210 ; OUT AFTER SPACES. FIX: PUT OUT LINE FEED FIRST.
00220
00230 ;232) CHANGE MODE TO MODES IN COMMAND TABLE. REMOVE LISTAB.
00240
00250 ;REV::
00260
00010 SUBTTL PARAMETERS AND DEFAULTS
00020
00030
00040 ;BIT POSITIONS FOR FLAGS WHICH MUST BE IN BYTE PTRS
00050
00060 FP.ADDR==0 ;BIT 0 IF ADDRESSES TO BE INCLUDED IN OUTPUT
00070 FP.APP==1 ;BIT 1 IF TO APPEND TO OUTPUT
00080 FP.AUTO==2 ;BIT 2 IF AUTOFORMATTING ON
00090 FP.INST==3 ;BIT 3 IF INSTRUCTION MODE SELECTED
00100 FP.PROG==4 ;BIT 4 IF PROGSYM ON
00110 FP.SUBT==5 ;BIT 5 IF SUBTITLES REQUESTED
00120
00130 ;FLAGS LH F
00140
00150 L.ADDR==(1B<FP.ADDR>) ;SET IF ADDRESSES TO BE OUTPUT
00160 L.APP==(1B<FP.APP>) ;SET IF APPEND TO OUTPUT FILE, CLEAR IF SUPERSEDE
00170 L.AUTO==(1B<FP.AUTO>) ;SET IF AUTOFORMATTING ON
00180 L.INST==(1B<FP.INST>) ;SET IF INSTRUCTION MODE SELECTED
00190 L.PROG==(1B<FP.PROG>) ;SET IF PROGSYM ON
00200 L.SUBT==(1B<FP.SUBT>) ;SET IF SUBTITLES REQUESTED
00210 L.TITL==(1B6) ;SET IF TITLE SPECIFIED
00220 L.IOPN==(1B7) ;SET IF INPUT FILE OPEN
00230 L.OOPN==(1B10) ;SET IF OUTPUT FILE OPEN
00240 L.IEOF==(1B8) ;SET IF EOF ON INPUT FILE
00250 ;L.NAS==(1B9) ;SET IF OUTPUT NOT ASCII ONLY OR SIXBIT ONLY
00260 ;L.ASCO==(1B11) ;SET IF OUTPUT IS ASCII
00270 ;L.SIXO==(1B12) ;SET IF OUTPUT IS SIXBIT
00280 L.SYM==(1B13) ;SET IF AN OUTPUT MODE REQUIRES SYMBOL LOOKUP
00290 L.NXM==(1B14) ;SET IF TRIED TO FIND NON-EXISTENT LOCATION IN INPUT FILE
00300 L.ALLD==(1B15) ;SET IF DUMPING ALL OF INPUT FILE
00310 L.OTTY==(1B16) ;SET IF OUTPUT DEVICE IS A TTY
00320 L.TDMP==(1B17) ;SET IF OUTPUT TO TTY AND OUTPUT DEVICE
00010 ;FLAGS RH F
00020
00030 R.CON1==1B18 ;SET IF DUMPING CONTENTS, NOT JUST ADDR
00040 R.ANY==1B19 ;SET IF ANYTHING FOUND IN EXPEVA
00050 R.CMAL==1B20 ;SET IF COMMA LEGAL (LEFT ANGLE BRACKET SEEN)
00060 R.CONB==1B21 ;SET IF BYTE DESCRIPTOR WAS CONTENTS, NOT JUST ADDR
00070 R.RPN==1B22 ;SET IN EXPRESSION EVALUATOR FOR RIGHT PAREN, ETC.
00080 R.CNT==1B23 ;SET IF ONLY COUNTING CHARS, NOT OUTPUTTING
00090 R.SCNT==1B24 ;SAVE COUNT BIT IN FORMAT SUBROUTINE
00100 R.OVR==R.CONB ;SET IF OUTPUT LINE OVERFLOWS RIGHT MARGIN
00110 R.LFD==R.CMAL ;SET IF LEADING LF LISTED IN OUTPUT SUBROUTINE
00120 R.FFD==R.RPN ;SET IF LEADING FF LISTED IN OUTPUT SUBROUTINE
00130 R.LKF==R.OVR ;USED IN OPEN OUTPUT ROUTINE
00140 R.LTAB==1B25 ;USED IN LISTING TABS
00150 R.NORE==1B26 ;SET IN FORMAT ROUTINE TO PREVENT RECURSION
00160 R.PHED==1B27 ;SET IF TO OUTPUT PAGE HEADER BEFORE NEXT CHAR
00170 R.LHED==1B28 ;SET IF TO OUTPUT LINE HEADER BEFORE NEXT CHAR
00180 R.MARS==1B29 ;SET IF TO OUTPUT SPACES FOR LEFT MARGIN
00190 R.RLH==1B30 ;REMEMBERS R.HED IN PAGE HEADER SUBROUTINE
00200
00210 ;FLAGS IN LH OF DL
00220
00230 DL.JUS==(1B1) ;SET IF END OF JUSTIFY LIST NOT YET SEEN
00240 DL.WID==(1B2) ;SET IF END OF WIDTH LIST NOT YET SEEN
00250 DL.SYM==(1B3) ;SET IF READING SYMBOL FILE NOT SAVE FILE
00260 DL.FBR==(1B4) ;SET IF WE NEED TO SORT SYMBOL TABLE
00270 DL.PNF==(1B5) ;USED TO SCAN SYMBOL TABLE WHEN GOING
00280 DL.MDL==(1B6) ; FROM SYMBOLIC TO BINARY
00290 DL.SNF==(1B7) ;FLAG SET WHEN DOING BINARY SCAN AND SYMBOL
00300 ; IS NOT FOUND (USED TO PREVENT LOOP)
00310 DL.NBR==(1B8) ;FLAG SET IF LAST CALL TO VALUE SYMBOL CONVERTER
00320 ; (VAL2SY) GAVE ERROR RETURN.
00330 DL.NXM==(1B9) ;<NXM> OUTPUT
00340 DL.TR5==(1B10) ;SET TO 1 WHEN SCANING SYMBOL TABLE AND AN
00350 ; UNDEFINED SYMBOL IS SEEN. IT CAUSES RADIX50
00360 ; GENERATOR TO OUTPUT TO TTY:.
00370 DL.XCT==(1B11) ;SET TO 1 IF ONLY AN EXACT MATCH WILL DO
00380 ; WHEN TYPING OUT SYMBOLS
00390 DL.ANXM==(1B12) ;SET IF USER DID A CORE ZERO, DCORE.
00400 DL.SYF==(1B13) ;SET BY SYFILE
00010 ;MISC
00020
00030 ND PDLEN,200
00040 ND LN.DRB,6
00050 ND WINSIZ,2000
00060 ND FBMTIM,5
00070 ND EC.FBM,3
00080 ND POSSHF,^D30
00090
00100 PHLINS==4 ;NUMBER OF LINES OUTPUT IN PAGE HEADER
00110 ND MINLPG,PHLINS ;MINIMUM NUMBER OF LINES PER PAGE
00120 IFL MINLPG-PHLINS-1,<MINLPG==PHLINS+1 ;MUST NOT BE LESS THAN LINES IN PAGE HEADER+1>
00130
00140 ;DAEMON CATEGORIES
00150
00160 CA.JOB==1 ;JOB INFORMATION
00170 CA.CNF==2 ;CONFIGURATION TABLE
00180 CA.DDB==3 ;DDB'S
00190 CA.COR==4 ;USER'S CORE
00200
00210 ND CA.MAX,4
00220
00230 ;DEVCHR BITS
00240
00250 DV.TTY==(1B5) ;TTY
00260 DV.DIR==(1B15) ;DIRECTORY DEVICE
00270
00280
00290 ;FLAGS IN RADIX50 SYMBOLS
00300
00310 ST.SPD==(1B0) ;IF 1 DO NOT TYPE OUT THIS SYMBOL
00320 ST.SPI==(1B1) ;IF 1 DO NOT MATCH ON INPUT
00330 ST.LCL==(1B2) ;IF 1 THIS IS A LOCAL
00340 ST.GLB==(1B3) ;IF 1 THIS IS A GLOBAL
00350 ST.PGM==(17B3) ;IF ALL 4 BITS ARE ZERO THIS IS A PROGRAM NAME
00360 ST.SIN==(5B3) ;GLOBAL WICH DOES NOT TYPE OUT
00370 ST.KIL==(14B3) ;TYPE $$K TO DDT ON THIS SYMBOL
00010 ;ASCII CHARS
00020
00030 C.LF==12 ;LINE FEED
00040 C.VT==13 ;VERTICAL TAB
00050 C.FF==14 ;FORM FEED
00060 C.CR==15 ;CARRIAGE RETURN
00070 C.ALT==33 ;ALTMODE
00080 C.DQ==42 ;DOUBLE QUOTE
00010 ;DEFAULTS FOR VERB TABLES
00020
00030 DM ADR,ONOFOF,ONOFON,ONOFON
00040 DM CAT,CA.MAX,CA.COR,CA.COR
00050 DM INS,1,1,1
00060 DM IRX,^D10,^D10,^D10
00070 DM LMG,0,0,0
00080 DM LNP,0,^D50,^D50
00090 DM NPG,10000,0,1
00100 DM ORX,^D10,^D8,^D8
00110 DM PGL,0,^D50,^D50
00120 DM RMG,0,^D60,^D60
00130
00140 ND AD.TYP,T.DATA
00150
00010 ;JUSTIFY KEYS
00020
00030 J.LFT==0 ;LEFT JUSTIFY
00040 J.CEN==1 ;CENTER JUSTIFY
00050 J.RHT==2 ;RIGHT JUSTIFY
00060
00070 J.END==<1_J.S>-1 ;END OF LIST MARKER
00080
00090 J.S==2 ;NUMBER OF BITS IN JUSTIFY FIELDS
00010 ;MODES KEYS
00020
00030 DEFINE MODXM<
00040 MODXMC <NULL,ASCII,SIXBIT,RADIX5,OCTAL,SOCTAL,DECIMA,FLOAT,SYMBOL,SMART,NUMERI,ALL>
00050 >
00060
00070 DEFINE MODXMC(A)<
00080 ZZ==-1
00090 IRP A,<
00100 M.'A==<ZZ==ZZ+1>
00110 >>
00120 MODXM
00130
00140 M.END==<1_M.S>-1 ;END OF LIST MARKER
00150
00160 M.S==4 ;NUMBER OF BITS IN MODES FIELD
00010 ;SUBTITLE KEYS
00020
00030 SUBT.S==7 ;STANDARD ASCII CHARACTER SIZE
00040
00050 SUBT.E==0 ;END OF SUBTITLE CHARACTER
00060
00070
00080
00090 ;TITLE KEYS
00100
00110 TIT.S==7 ;STANDARD ASCII CHARACTER SIZE
00120
00130 TIT.EN==0 ;END OF TITLE CHARACTER
00010 ;TYPE KEYS FOR FILE TYPE
00020
00030 DEFINE TYPXM<
00040 TYPXMC <TMP,DAE,SHR,SAV,HGH,LOW,XPN,DMP,SDSK,DDIR,DECT,DATA>
00050 >
00060
00070 DEFINE TYPXMC(A)<
00080 ZZ==0
00090 IRP A,<T.'A==<ZZ==ZZ+1>>>
00100
00110 ;DEFINE TYPES
00120
00130 TYPXM
00140
00150 T.EEND==T.DMP ;END OF EXTENSIONS WHICH ARE ALSO TYPES
00010 ;WIDTH KEYS
00020
00030 W.END==<1_W.S>-1 ;END OF LIST MARKER
00040
00050 W.S==9 ;NUMBER OF BITS IN WIDTH FIELDS
00010 DEFINE VERBSW<
00020
00030 SP ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
00040 SP *ALL,,ALLDMP
00050 SS APPEND,<POINT 1,F,FP.APP>,1
00060 SP AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
00070 SP BEGIN,,BEGIN
00080 SP CATEGORY,CATNUM,CATRED,CAT
00090 SP CLOSE,,CLSFIL
00100 SP COFILE,C.ZER,CGTFIL
00110 SP COMPARE,,CMPDMP
00120 SP DELSYM,,DELSYM
00130 SP DO,,DOPROC
00140 SP *DUMP,,DMPBYT
00150 SP EJECT,,EJECT
00160 SP END,,ENDPRC
00170 SP EXIT,,XIT
00180 SP IF,,IFPROC
00190 SP INDEX,,E.NIMP
00200 SP *INPUT,I.ZER,IGTFIL
00010 SP IOFFSET,,IOFPRC
00020 SP INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
00030 SP IRADIX,IRADIX,.SWDEC##,IRX
00040 SP JUSTIFY,,JUSPRC
00050 SP LEFTMARGIN,LMARGN,EXPSTO,LMG
00060 SP LINEPAGE,LINPAG,LINPGS,LNP
00070 ;SP LISTAB,,LISPRC
00080 SP *MODES,,MODPRC
00090 SP NUMPAGE,PAGNUM,EXPSTO,NPG
00100 SP OOFFSET,,OOFPRC
00110 SP ORADIX,ORADIX,.SWDEC##,ORX
00120 SP *OUTPUT,O.ZER,OGTFIL
00130 SP PAGELIMIT,PAGLIM,EXPSTO,PGL
00140 SP POP,,POPPRC
00150 SL PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
00160 SP PUSH,,PUSHPR
00170 SP RIGHTMARGIN,RMARGN,EXPSTO,RMG
00180 SP SKPBLOCKS,SBLOCK,EXPSTO
00190 SP SKPFILES,SFILES,EXPSTO
00010 SP SORT,,E.NIMP
00020 SS SUBTITLE,<POINT 1,F,FP.SUBT>,1
00030 SS SUPERSEDE,<POINT 1,F,FP.APP>,0
00040 SP SYMBOL,,SYMPRC
00050 SP SYFILE,S.ZER,SGTFIL
00060 SP TABSYM,,TSYMPR
00070 SP TCOMPARE,,TCMDMP
00080 SP *TDUMP,,TDMBYT
00090 SP TSORT,,E.NIMP
00100 SP TITLE,,TITPRC
00110 SL TYPE,F.ZER+%TYP,TYPE
00120 SP WIDTH,,WIDPRC
00130 SP XTRACT,,XPROC
00140 > ;END SWTCHS MACRO
00150
00010 DEFINE SWTCHS,<VERBSW>
00020 DOSCAN(VERB)
00010 RELOC
00020 IBUF: BLOCK 200 ;INPUT BUFFER (MUST BE HERE SO WE CAN PHASE CODE
00030 ; INTO IT)
00040 RELOC
00010 ;TABLE OF SWITCHES WHICH ARE LEGAL IN SWITCH.INI
00020 ; THIS SWITCHES MAY BE PLACED IN A FILE ON THE USERS AREA WHICH
00030 ; WILL SET HIS USERS SPECIFIC DEFAULTS.
00040 DEFINE SWTCHS<
00050
00060 SP ADDRESS,<POINT 1,F,FP.ADDR>,ADDRST,ADR
00070 SS APPEND,<POINT 1,F,FP.APP>,1
00080 SP AUTOFORM,<POINT 1,F,FP.AUTO>,AUTOST,ADR
00090 SP CATEGORY,CATNUM,CATRED,CAT
00100 SP INSTRUCTION,<POINT 1,F,FP.INST>,INSTST,INS
00110 SP IRADIX,IRADIX,.SWDEC##,IRX
00120 SP JUSTIFY,,JUSPRC
00130 SP LEFTMARGIN,LMARGN,.SWDEC##,LMG
00140 SP LINEPAGE,LINPAG,LINPGS,LNP
00150 SP *MODES,,MODPRC
00160 SP NUMPAGE,PAGNUM,.SWDEC##,NPG
00170 SP ORADIX,ORADIX,.SWDEC##,ORX
00180 SP PAGELIMIT,PAGLIM,.SWDEC##,PGL
00190 SL PROGSYM,<POINT 1,F,FP.PROG>,ONOF,1
00200 SP RIGHTMARGIN,RMARGN,.SWDEC##,RMG
00210 SS SUPERSEDE,<POINT 1,F,FP.APP>,0
00220 SL TYPE,F.ZER+%TYP,TYPE
00230 SP WIDTH,,WIDPRC
00240 > ;END SWTCHS MACRO
00250
00260
00010 XALL
00020 DOSCAN (OPTN)
00030 XALL
00010
00020 ;SPECIAL TABLE OF ABSENT DEFAULTS
00030
00040 DEFINE SL(A,B,C,D)<
00050 EXP D ;DEFAULT FOR /'A
00060 >
00070
00080 DEFINE SP(A,B,C,D)<
00090 EXP AD.'D ;DEFAULT FOR /'A
00100 >
00110
00120 DEFINE SS(A,B,C)<
00130 EXP 0 ;DEFAULT FOR /'A
00140 >
00150
00160 AD.==0
00170 XALL
00180
00190 ABSTAB: VERBSW
00010 DEFINE SL(NAME,RESULT,TABLE,DEFAULT),<
00020 X NAME,TABLE'.T-1,<RESULT>,DEFAULT,-TABLE'.L
00030 >
00040
00050 DEFINE SP(NAME,RESULT,PROCESSOR,ABBR),<
00060 X NAME,PROCESSOR,<RESULT>,PD.'ABBR,MX.'ABBR
00070 >
00080
00090 DEFINE SS(NAME,RESULT,VALUE),<
00100 X NAME,0,<RESULT>,VALUE,0
00110 >
00010 ;AND FINALLY, THE KEY-WORD VALUES
00020
00030 KEYS ONOF,<ON,OFF>
00040 KEYS CATM,<JOB,CONFIG,DDB,CORE>
00050 KEYS DENS,<0,2,5,8>
00060 KEYS JUST,<LEFT,CENTER,RIGHT>
00070 KEYS PARI,<,ODD,EVEN>
00010 DEFINE TYPXMC(A)<
00020 XLIST
00030 IRP A,<SIXBIT \A\>
00040 LIST>
00050
00060 TYPE.T: TYPXM
00070 TYPE.L==.-TYPE.T
00080
00090 DEFINE MODXMC(A)<
00100 XLIST
00110 IRP A,<SIXBIT \A\>
00120 LIST>
00130
00140 MODE.T: MODXM
00150 MODE.L==.-MODE.T
00160
00170
00010 SUBTTL BUILT-IN SYMBOLS
00020
00030 ;THIS IS A TABLE OF SPECIAL BUILT IN SYMBOLS. THE USERS SYMBOL TABLE
00040 ; IS SEARCHED FOR THE SYMBOL AND IF IT IS NOT FOUND THE BUILT-IN TABLE
00050 ; IS TRIED. THE S MACRO HAS 2 ARGUMENTS: THE FIRST IS THE SYMBOL AND
00060 ; THE SECOND IS THE LOCATION WITHIN DUMP CONTAINING THE VALUE OF THAT
00070 ; SYMBOL.
00080
00090 DEFINE MSYM,<
00100 S <.>,SAVE4. ;THE ADDRESS OF THE LAST WORD TYPED OUT
00110 ; THIS IS THE LOCATION COUNTER.
00120 S <$>,SAVE4$ ;THE LAST BYTE TYPED OUT.
00130 S <%>,SAVEXP ;THE LAST THE THE EXPERSSION EVALUATOR
00140 ; RETURNED. THIS IS A SORT OF . IMMEDIATE
00150 ; SO D UUOCON:UCLJMP&%+100 IS THE SAME AS
00160 ; D UUOCON:UCLJMP&UUOCON:UCLJMP+100
00170 >
00180
00190 XALL
00200 DEFINE S(A,B),<
00210 RADIX50 0,A ;A IN RADIX50
00220 >
00230
00240 MSYMTB: MSYM ;BUILT-IN SYMBOL TABLE
00250 L.MSYM==.-MSYMTB
00260
00270 DEFINE S(A,B)<
00280 EXP B ;POINTER TO VALUE OF A
00290 >
00300 MSYMAD: MSYM
00010 SUBTTL ROUTINE TO HANDLE EXPRESSION VALUED SWITCHES
00020 ;SUBROUTINE TO GET AN EXPRESSION AND STORE
00030 ;ARGS P1=INDEX IN VERB TABLE
00040
00050 EXPSTO: HRRZ T1,VERBD(P1) ;PICK UP DEFAULT
00060 SKIPE T2,VERBP(P1) ;PICK UP STORAGE LOCATION
00070 DPB T1,T2 ;STOR DEFAULT IF WE KNOW WHERE
00080 PUSHJ P,EXPEVA ;EVALUATE THE EXPRESSION
00090 HLRZ T2,VERBM(P1) ;GET MAX LEGAL VALUE
00100 JUMPE T2,EXPST1 ;JUMP IF NO MAX
00110 CAMLE T1,T2 ;SKIP IF VALUE SPECIFIED .LE. MAX
00120 JRST E.MAX ;NO. ERROR.
00130 EXPST1: SKIPN T2,VERBP(P1) ;GET THE POINTER
00140 POPJ P, ;NONE.
00150 MOVE N,T1 ;N=VALUE TO BE STORED
00160 MOVEI P2,[0
00170 VERBP(P1)]
00180 PJRST .SWDPB## ;STORE THE VALUE
00010 SUBTTL INITIALIZE
00020
00030 ;REPEAT FOR EACH SUPPORTED
00040 ; ENTRY POINT.
00050 DUMP: REPEAT 2,<JSP T3,DUMPGO> ;T3 _ ADDRESS OF ENTRY
00060 DUMPGO: SUBI T3,DUMP+1 ;CONVERT TO OFFSET
00070 HRRZM T3,SAOFST# ;STORE FOR SCAN TO LOOK AT
00080 RESET
00090 MOVE P,PDL ;SET UP PUSH DOWN LIST POINTER
00100
00110 ;HERE TO CLEAR CORE
00120
00130 SETZB F,ZER ;CLEAR FLAGS AND FIRST LOC OF CORE
00140 MOVE T1,[XWD ZER,ZER+1]
00150 BLT T1,EZER
00160
00170 ;HERE TO INIT SCANNER
00180
00190 MOVE 1,[3,,[0
00200 SAOFST,,'DMP'
00210 0]]
00220 PUSHJ P,.ISCAN ;CALL SCAN
00230
00240
00250 ;HERE TO SCAN SWITCH.INI FOR USER SPECIFIC DEFAULTS
00260
00270 SETZM FM ;CLEAR THE MASK WORD
00280 MOVSI P1,-OPTNL ;LENGTH OF OPTION TABLE
00290 OPTSET: HLRZ T1,OPTNP(P1) ;GET THE POINTER TYPE
00300 CAIN T1,004400 ;FULL WORD VALUE?
00310 SETOM @OPTNP(P1) ;YES-- -1 IS FLAG FOR UNKNOWN
00320 AOBJN P1,OPTSET ;LOOP OVER THAT TABLE
00330 MOVE 1,[4,,[IOWD OPTNL,OPTNN
00340 XWD OPTND,OPTNM
00350 XWD 0,OPTNP
00360 EXP -1]]
00370 PUSHJ P,.OSCAN## ;SCAN THE FILE
00010 ;HERE TO STORE ABSENT DEFAULTS
00020
00030 MOVSI P1,-VERBL ;MINUS LENGTH OF VERB TABLES
00040 ABDEFS: SKIPN T1,VERBP(P1) ;GET THE POINTER
00050 JRST ABDEF1 ;IF NONE SKIP SWITCH
00060 MOVE T3,@T1 ;GET THE WORD WITH THE BYTE
00070 HLRZ T2,T1 ;GET THE SIZE PART
00080 CAIN T2,004400 ;IS IT A FULL WORD
00090 JRST [AOJN T3,ABDEF1 ;YES--JUMP IF KNOWN ALREADY
00100 JRST ABDEF2] ; ELSE FILL IN DEFAULT
00110 AOS T1 ;BYTES HAVE A MASK WORD
00120 LDB T1,T1 ;GET THE MASK
00130 JUMPN T1,ABDEF1 ;SKIP IF FILLED IN
00140 ABDEF2: MOVE T1,ABSTAB(P1) ;ABSENT DEFAULT
00150 PUSHJ P,EXPST1 ;STORE DEFAULT
00160 ABDEF1: AOBJN P1,ABDEFS
00170 ;HERE TO SET UP TABLES
00180
00190 MOVSI T2,-LSTTAB-1
00200 MOVE T1,.JBFF ;FIRST AVAILABLE LOCATION
00210 MOVEM T1,TABVEC(T2) ;STORE AS ORIGIN OF EACH TABLE
00220 AOBJN T2,.-1
00230
00240 ;HERE TO SET UP IOWD'S
00250
00260 MOVE T1,[IOWD 200,IBUF]
00270 MOVEM T1,INPLST
00280 MOVE T1,[IOWD WINSIZ,WINDOW]
00290 MOVEM T1,WINLST
00300
00010 ;HERE TO SET UP DEFAULTS
00020
00030 OTDEFS: TLO F,L.ADDR+L.APP+L.AUTO+L.INST+L.PROG
00040 MOVE P1,M.Y ;BYTE POINTER FOR MODES LIST
00050 PUSHJ P,MKPNTR
00060 MOVEI P2,MODNDX
00070 MOVEI T1,M.OCTA ;OCTAL
00080 PUSHJ P,STOBYT
00090 MOVEI T1,M.END ;END OF LIST
00100 PUSHJ P,STOBYT
00110 MOVE P1,J.Y ;BYTE POINTER FOR JUSTIFY LIST
00120 PUSHJ P,MKPNTR
00130 MOVEI P2,JUSNDX
00140 MOVEI T1,J.END ;START WITH NULL LIST
00150 PUSHJ P,STOBYT
00160
00170 MOVE P1,W.Y ;BYTE POINTER FOR WIDTH LIST
00180 PUSHJ P,MKPNTR
00190 MOVEI P2,WIDNDX
00200 MOVEI T1,W.END
00210 PUSHJ P,STOBYT
00220
00230 MOVSI T1,(SIXBIT .LPT.) ;DEFAULT OUTPUT DEVICE
00240 MOVEM T1,O.DEV
00250 MOVSI T1,(SIXBIT .DSK.)
00260 MOVEM T1,I.DEV ;INPUT DEFAULT IS DSK
00270 MOVEM T1,S.DEV
00280 MOVEM T1,C.DEV
00290 PJOB T1, ;GET JOB NUMBER
00300 PUSHJ P,.MKPJN ;CONVERT TO SIXBIT IN LH
00310 MOVS T4,T1 ;GET JOB NUMBER
00320 HRRI T4,(SIXBIT .DAE.)
00330 MOVEM T4,O.NAM ;DEFAULT OUTPUT NAME
00340 MOVEM T4,I.NAM ;DEFAULT INPUT NAME
00350 MOVEM T4,S.NAM ;DEFAULT SYMBOL NAME
00360 MOVEM T4,C.NAM ;DEFAULT COMPARISON FILE NAME
00370 MOVSI T1,(SIXBIT .LSD.)
00380 MOVEM T1,O.EXT ;DEFAULT OUTPUT EXTENSION
00010 SUBTTL MAIN LOOP
00020
00030 ;HERE FOR MAIN LOOP - CALL COMMAND SCANNER
00040
00050 MOVE 1,[6,,[IOWD VERBL,VERBN
00060 XWD VERBD,VERBM
00070 XWD 0,VERBP
00080 EXP -1
00090 XWD FAREAL,FAREA
00100 XWD 0,PAREA]]
00110 MOVEI DL,I.ZER
00120 PUSHJ P,.VSCAN
00130 JRST XIT
00010 SUBTTL VERB PROCESSORS
00020 ;SUBROUTINE TO READ FILE SPECIFIER AND STORE IN APPROPRIATE BLOCK
00030
00040 IGTFIL: TLZ F,L.IOPN!L.IEOF ;NOTE INPUT NOT OPEN
00050 SETZM I.DEV+%TYP ;ALLOW NEW TYP SPECIFICATION
00060 PUSHJ P,GETFIL ;GO GET THE SPEC
00070 MOVEI T2,S.ZER ;LOAD THE ADDRESS OF SYFILE BLOCK
00080 TLNN DL,DL.SYF ;SYFILE COMMAND GIVEN?
00090 PJRST CPYSPC ;NO--NEW DEFAULT
00100 POPJ P, ;YES--NO CHANGE
00110
00120 OGTFIL: PUSHJ P,CLSFIL ;CLOSE CURRENT OUTPUT FILE
00130 TLZ F,L.OOPN!L.OTTY ;NOTE OUTPUT FILE NOT OPEN
00140 SETZM LINNUM ;START AT TOP OF PAGE
00150 JRST GETFIL
00160
00170 SGTFIL: TLO DL,DL.SYF ;FLAG SYFILE GIVEN
00180 CGTFIL:
00190 GETFIL: JUMPLE C,.POPJ ;RETURN IF NULL SPEC
00200 PUSHJ P,.FILIN ;READ FILE SPECIFIER
00210 MOVEI T1,F.ZER ;POINT TO BLANK SPEC
00220 MOVEI T2,F.LEN ;LENGTH OF SAME
00230 PUSHJ P,.GTSPC ;BLT THE SPEC FROM SCAN
00240 HRRZ T2,VERBP(P1) ;ADDR OF BLOCK TO STORE RESULT
00250 CPYSPC: SKIPE T1,F.ZER+%DEV ;SKIP IF NO DEVICE SPECIFIED
00260 MOVEM T1,%DEV(T2) ;STORE DEVICE IN BLOCK
00270 SKIPE T1,F.ZER+%NAM ;SKIP IF NO NAME SPECIFIED
00280 MOVEM T1,%NAM(T2) ;STORE NAME IF BLOCK
00290 SKIPE T1,F.ZER+%EXT ;SKIP IF NO EXT SPECIFIED
00300 MOVEM T1,%EXT(T2)
00310 SKIPE T1,F.ZER+%DIR ;SKIP IF DIRECTORY SPECIFIED
00320 MOVEM T1,%DIR(T2)
00330 SKIPE T1,F.ZER+%MOD
00340 MOVEM T1,%MOD(T2)
00350 SKIPE T1,%TYP+F.ZER
00360 MOVEM T1,%TYP(T2)
00370 POPJ P,
00010 INSTST:
00020 AUTOST:
00030 ADDRST: SKIPA T1,[IOWD ONOF.L,ONOF.T] ;PTR TO LIST FOR ON OR OFF
00040 CATRED: MOVE T1,[IOWD CATM.LT,CATM.T] ;PTR TO LIST OF CATEGORIES
00050 ; PJRST LSTSTO ;FALL INTO LSTSTO
00060
00070 ;SUBROUTINE TO FIND A SWITCH VALUE IN A LIST
00080 ;ARGS T1=IOWD PTR TO LIST OF LEGAL SWITCHES
00090
00100 LSTSTO: MOVEM T1,KEYPTR ;SAVE IOWD PTR TO LIST OF LEGAL VALUES
00110 HRRZ T1,VERBD(P1) ;GET DEFAULT
00120 SKIPE T2,VERBP(P1) ;SKIP IF NO STORAGE PTR
00130 DPB T1,T2 ;STORE DEFAULT FIRST
00140 JUMPLE C,.POPJ ;EXIT IF NO VALUE SPECIFIED
00150 PUSHJ P,KLOOK ;FIND VALUE SPECIFIED IN LIST
00160 AOJA T1,EXPST1 ;+1 FOR INTERNAL FORM AND STORE
00010 ;SUBROUTINE TO EXIT TO MONITOR - CLOSES OUTPUT FIRST
00020
00030 XIT: PUSHJ P,CLSFIL ;CLOSE OUTPUT FILE
00040 EXIT 1 ;EXIT TO MONITOR
00050 EXIT
00060
00070 ;SUBROUTINE TO CLOSE OUTPUT FILE
00080
00090 CLSFIL: TLZN F,L.OOPN ;SKIP IF OUTPUT FILE OPEN
00100 POPJ P, ;NOOP IF NOT OPEN
00110 TLO F,L.APP ;FORCE APPEND MODE
00120 CLOSE OC,
00130 GETSTS OC,N ;GET STATUS
00140 RELEAS OC, ;GIVE UP THE DDB
00150 TRNN N,IO.ERR ;SKIP IF ANY ERRORS
00160 POPJ P,
00170 M.FAIO <ERROR CLOSING OUTPUT FILE, STATUS =>
00180
00190 ;SUBROUTINE TO STORE LINES PER PAGE AND WORRY ABOUT MINIMUM
00200
00210 LINPGS: PUSHJ P,EXPSTO ;STORE LINES PER PAGE AS SPECIFIED
00220 MOVEI T1,MINLPG ;GET MINIMUM
00230 CAMLE T1,LINPAG ;SKIP IF SPECIFIED GE MINIMUM
00240 MOVEM T1,LINPAG ;NO, STORE MINIMUM
00250 POPJ P,
00260
00270 GETSPC: MOVEI T1,F.ZER
00280 MOVEI T2,F.LEN
00290 PUSHJ P,.GTSPC
00300 MOVE T1,F.ZER+%TYP
00310 MOVEM T1,%TYP(P1)
00320 POPJ P,
00010 ;SUBROUTINE TO ACCEPT A TITLE
00020
00030 TITPRC: PUSHJ P,.SAVE4
00040 TLO F,L.TITL ;NOTE PRESENCE OF TITLE
00050 MOVEI P2,TITNDX ;INDEX IN TABLE VECTOR
00060 MOVE P1,TIT.Y ;BYTE POINTER FOR TITLE
00070 PUSHJ P,MKPNTR ;MAKE A REAL POINTER
00080 TITPR1: JUMPLE C,TITPRX ;EXIT AT END OF LINE
00090 PUSHJ P,.TIALT ;READ NEXT CHAR
00100 MOVE T1,C
00110 PUSHJ P,STOBYT ;STORE IN TITLE TABLE
00120 JRST TITPR1 ;AND LOOP TILL END OF LINE
00130 TITPRX: MOVEI T1,TIT.EN ;MARK END OF TITLE
00140 PJRST STOBYT
00150
00160 ;SUBROUTINE TO EVALUATE MODES LIST
00170
00180 MODPRC: MOVE P1,M.Y ;BYTE POINTER FOR MODES LIST
00190 PUSHJ P,MKPNTR ;CLEAR THE INDIRECT BIT
00200 MOVEI P2,MODNDX ;INDEX IN TABLE VECTOR
00210 MOVE T1,[IOWD MODE.L,MODE.T]
00220 PJRST TABPRC ;PROCESS LIST
00010 ;SUBROUTINE TO EVALUATE JUSTIFY LIST
00020
00030 JUSPRC: MOVE P1,J.Y ;BYTE POINTER FOR JUSTIFY LIST
00040 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00050 MOVEI P2,JUSNDX ;INDEX IN TABLE VECTOR
00060 MOVEI T1,J.END ;START WITH EMPTY LIST
00070 PUSHJ P,STOBYT ;STORE END OF LIST
00080 MOVE P1,J.Y
00090 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00100 MOVE T1,[IOWD JUST.LT,JUST.T]
00110 ; PJRST TABPRC ;PROCESS LIST
00120
00130 ;SUBROUTINE TO READ TTY AND STORE A SERIES OF BYTES FOR KEY WORDS
00140 ;ARGS T1=AOBJN PTR TO LIST OF KEY WORDS
00150 ; P1=BYTE POINTER (TO BE INCREMENTED)
00160 ; P2=INDEX IN TABLE VECTOR OF TABLE
00170
00180 TABPRC: MOVEM T1,KEYPTR ;SAVE POINTER TO LIST OF KEYWORDS
00190 TABPR1: JUMPLE C,TABPR2 ;EXIT AT END OF LINE
00200 PUSHJ P,KLOOK ;FIND KEY WORD IN LIST
00210 PUSHJ P,STOBYT ;STORE VALUE
00220 JRST TABPR1
00230 TABPR2: SETO T1, ;END OF LIST FLAG
00240 PJRST STOBYT ;STORE IT
00250
00260 ;SUBROUTINE TO LOOK UP A KEY WORD IN A LIST
00270 ;ARGS KEYPTR=IOWD PTR TO LIST OF LEGAL VALUES
00280 ;VALUES T1=INDEX IN LIST IF FOUND
00290
00300 KLOOK: PUSHJ P,.SIXSW ;GET KEYWORD
00310 MOVE T1,KEYPTR ;PTR TO LIST OF KEY WORDS
00320 PUSHJ P,.NAME ;LOOK IT UP
00330 JRST E.UKK ;UNKNOWN KEY WORD
00340 HRRZ T2,KEYPTR ;ADDR OF BEGINNING OF LIST
00350 MOVEI T1,-1(T1)
00360 SUB T1,T2 ;INDEX IN LIST IS VALUE
00370 POPJ P,
00010 ;SUBROUTINE TO EVALUATE WIDTH LIST
00020
00030 WIDPRC: MOVE P1,W.Y ;BYTE POINTER FOR WIDTH LIST
00040 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00050 MOVEI P2,WIDNDX ;INDEX IN TABLE VECTOR
00060 MOVEI T1,W.END ;START WITH EMPTGY LIST
00070 PUSHJ P,STOBYT ;STORE END OF LIST
00080 MOVE P1,W.Y
00090 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00100 WIDPR1: JUMPLE C,WIDPR2 ;EXIT AT END OF LINE
00110 PUSHJ P,EXPEVA ;EVALUATE EXPRESSION
00120 PUSHJ P,STOBYT ;STORE IT
00130 JRST WIDPR1
00140 WIDPR2: MOVEI T1,W.END ;MARK END OF LIST
00150 PJRST STOBYT ; AND STORE IT
00160
00170 EJECT: PUSHJ P,OPNOUT ;MAKE SURE OUTPUT FILE OPEN
00180 PJRST NEWPAG ;OUTPUT PAGE EJECT AND PAGE HEADER
00010 ;SUBROUTINE TO DUMP ALL OF FILE
00020
00030 ALLDMP: JUMPG C,E.EXP
00040 PUSH P,C ;SAVE LAST CHAR INPUT
00050 SETZM SAVADR ;START AT LOCATION 0
00060 SETZM SAVPOS ;START OF WORD
00070 MOVEI T1,^D36 ;36 BIT BYTES
00080 MOVEM T1,SAVSIZ
00090 HRLOI T1,377777 ;GO TO END OF FILE
00100 MOVEM T1,TRMADR
00110 SETZM TRMPOS
00120 MOVEI T1,1 ;INCREMENT BY 1 WORD
00130 MOVEM T1,INCADR
00140 SETZM INCPOS
00150 PUSHJ P,OPNOUT ;MAKE SURE OUTPUT FILE OPEN
00160 PUSHJ P,NEWLIN
00170 SETZB T1,INCSIZ
00180 TRO F,R.CON1 ;NOTE DUMPING CONTENTS
00190 PUSHJ P,FNDADR ;GET CONTENTS OF ZERO
00200 TLNN F,L.NXM ;SKIP IF NXM ALREADY
00210 PUSHJ P,OUTPT ;OUTPUT LOCATION 0
00220 MOVE T1,%TYP(DL) ;TYPE OF INPUT FILE
00230 MOVE T2,CATNUM ;CATEGORY IN CASE ITS DAEMON FILE
00240 CAIN T1,T.DAE ;SKIP IF NOT A DAEMON FILE
00250 CAIE T2,CA.COR ;SKIP IF CORE CATEGORY
00260 JRST ALLDM1 ;NO, JUST GO AHEAD
00270 TRO F,R.CON1 ;SET CONTENTS BIT
00280 MOVEI T1,.JBREL ;ADDR OF .JBREL
00290 PUSHJ P,FNDADR ;RETRIEVE .JBREL
00300 MOVEM T1,LOWREL ;SAVE FOR LATER
00310 ALLDM1: TLO F,L.ALLD ;NOTE DUMPING WHOLE FILE
00320 MOVE T2,HGHOFF ;GET OFFSET FOR HISEG
00330 CAIE T1,T.HGH ;IS THIS A HIGH SEG
00340 CAIN T1,T.SHR ; OR A .SHR SEG?
00350 MOVEM T2,SAVADR ;YES--START AT 400000
00360 PJRST DMPXC0
00010 ;SUBROUTINE TO EXECUTE A DUMP REQUEST
00020
00030 DMPBYT: TLZA F,L.TDMP ;DO NOT DUMP ON TTY
00040 TDMBYT: TLO F,L.TDMP ;ALSO DUMP ON TTY:
00050 JUMPLE C,.POPJ ;GIVE UP IF NOTHING TO DO
00060 TLZ DL,DL.NXM ;CAUSE ANOTHER MESSAGE
00070 PUSHJ P,OPNOUT ;MAKE SURE OUTPUT FILE OPEN
00080 PUSH P,C ;SAVE BREAK
00090 PUSHJ P,NEWLIN ;START DUMP ON NEW LINE
00100 POP P,C ;RESTORE C
00110 MOVE T2,SAVADR ;GET LAST ADDRESS TYPED OUT
00120 MOVEM T2,SAVE4. ;SAVE FOR .
00130 MOVE T2,OUTVAL ;GET LAST BYTE TYPED OUT
00140 MOVEM T2,SAVE4$ ;SAVE FOR $
00150 DMPBYS: TRZ F,R.CON1 ;CLEAR CONTENTS FLAG
00160 PUSHJ P,EXPEV0 ;EVALUATE FIRST EXPRESSION
00170 MOVEM T1,SAVEXP ;STORE FOR %
00180 CAIN C," " ;SEE IF DELIMITER IS A SPACE AND
00190 PUSHJ P,.TIAUC## ; IF SO GET ANOTHER CHAR.
00200 CAIN C,"'" ;SKIP IF NOT A STRING COMING
00210 TRNE F,R.ANY ;SKIP IF STRING AND NO DUMP DESC.
00220 JRST DMPBY1 ;DO BYTE FIRST
00230 JRST DMPEXA ;NOTHING TO DUMP
00240 DMPBY1: MOVE T2,POSTMP ;POSITION SPECIFIED
00250 MOVEM T2,SAVPOS
00260 MOVE T2,SIZTMP
00270 MOVEM T2,SAVSIZ
00280 PUSH P,C ;SAVE LAST CHAR INPUT
00290 MOVEM T1,SAVADR ;ASSUME VALUE ONLY, SAVE AS ADDRESS
00300 TRNN F,R.CONB ;SKIP IF ACTUALLY CONTENTS OF ADDRESS
00310 JRST DMPBY2
00320 TRO F,R.CON1 ;NOTE DUMPING CONTENTS
00330 MOVE T2,ADRTMP ;ADDRESS FETCHED
00340 MOVEM T2,SAVADR ;IS ADDRESS TO SAVE
00350 DMPBY2: PUSHJ P,OUTPT ;OUTPUT VALUE OF FIRST BYTE
00360 SETZM INCSIZ ;DEFAULT SIZE INCREMENT
00370 MOVEI T1,1 ;DEFAULT POSITION=0(+1 FOR OFFSET)
00380 MOVEM T1,INCPOS ;STORE DEFAULT POSITION INCREMENT
00390 MOVEM T1,INCADR ;STORE DEFAULT ADDRESS INCREMENT
00400 MOVEI T1,^D37 ;DEFAULT END AT END OF THIS WORD
00410 MOVEM T1,TRMPOS
00420 MOVE T1,SAVADR ;ADDRESS OF THIS WORD
00430 MOVEM T1,TRMADR
00440 SKIPLE C,(P) ;RESTORE LAST CHAR INPUT, SKIP IF END OF LINE
00450 CAIE C,"&" ;SKIP IF TERMINATING BYTE SPECIFIED
00460 JRST DMPXC0 ;END OF THAT BYTE DESCRIPTOR, GET NEXT
00010 SETZM POSTMP
00020 SETZM SIZTMP
00030 PUSHJ P,EXPEVA ;EVALUATE TERMINATING BYTE SPECIFIER
00040 CAIN C," " ;IGNORE TRAILINGE SPACES
00050 PUSHJ P,.TIAUC## ; ..
00060 MOVEM T1,TRMADR ;SAVE TERMINATING ADDRESS
00070 SKIPN T1,POSTMP ;POSITION VALUE, SKIP IF SPECIFIED
00080 MOVEI T1,1 ;0 (+1 FOR OFFSET) IS DEFAULT
00090 MOVEM T1,TRMPOS
00100 CAIE C,"&" ;SKIP IF INCREMENT SPECIFIED
00110 JRST DMPXCT ;NO, USE DEFAULT INCREMENT
00120 SETZM POSTMP
00130 SETZM SIZTMP
00140 PUSHJ P,EXPEVA ;EVALUATE INCREMENT
00150 MOVEM T1,INCADR ;SAVE INCREMENT ADDRESS
00160 MOVE T1,POSTMP ;POSITION INCREMENT
00170 MOVEM T1,INCPOS
00180 MOVE T1,SIZTMP ;SIZE INCREMENT
00190 MOVEM T1,INCSIZ
00010 DMPXCT: MOVEM C,(P) ;SAVE LAST CHAR INPUT
00020 DMPXC0: MOVE T1,SAVADR ;ADDR OF LAST BYTE OUTPUT
00030 MOVE T2,SAVPOS ;POSITION LAST OUTPUT
00040 LSH T2,POSSHF
00050 ADD T2,SAVSIZ ;MAKE POSITION, SIZE WORD
00060 MOVE T3,INCADR ;INCREMENT ADDRESS
00070 MOVE T4,INCPOS ;INCREMENT POSITION
00080 LSH T4,POSSHF
00090 ADD T4,INCSIZ ;MAKE INCREMENT POSITION,SIZE WORD
00100 PUSHJ P,ADDBYT ;INCREMENT BYTE
00110 JOV DMPEX ;IF WE WENT FROM +INF TO -INF DO NOT
00120 ; LOOP FOR EVER.
00130 CAMLE T1,TRMADR ;SKIP IF NOT YET UP TO TERMINATING ADDRESS
00140 JRST DMPEX
00150 MOVEM T1,SAVADR ;SAVE NEW ADDR
00160 LDB T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET NEW POSITION
00170 MOVEM T1,SAVPOS
00180 MOVE T1,SAVADR
00190 CAME T1,TRMADR ;SKIP IF IN LAST WORD
00200 JRST DMPXC1 ;NO, GO AHEAD WITH DUMP
00210 MOVE T1,SAVPOS ;POSITION
00220 CAMLE T1,TRMPOS ;SKIP IF NOT YET PAST LAST BYTE IN WORD
00230 JRST DMPEX ;ALL DONE, EXIT
00240 DMPXC1: TLNN DL,DL.WID ;SKIP IF WE CONTROL OUR OWN WIDTHS
00250 PUSHJ P,LSPC3 ;ELSE OUTPUT 3 SPACES
00260 MOVE T1,SAVADR
00270 TRNE F,R.CON1 ;SKIP IF ONLY ADDRESSES ARE VALUES DUMPED
00280 PUSHJ P,FNDBYT ;FIND CONTENTS OF ADDRESS
00290 TLNN F,L.ALLD ;SKIP IF DUMPING WHOLE FILE
00300 JRST DMPXC2 ;NO, GO AHEAD
00310 TLNE F,L.NXM ;NO SKIP IF END OF FILE
00320 JRST DMPEX ;YES, END AT NXM
00330 MOVE T2,%TYP(DL) ;TYPE OF INPUT FILE
00340 MOVE T3,CATNUM ;CATEGORY IN CASE ITS A DAEMON FILE
00350 CAIN T2,T.DAE ;SKIP IF NOT A DAEMON FILE
00360 CAIE T3,CA.COR ;YES, SKIP IF CORE CATEGORY
00370 JRST DMPXC2 ;NO, GO AHEAD
00380 MOVE T2,LOWREL ;SIZE OF LOW SEGMENT
00390 CAMLE T2,SAVADR ;SKIP IF ADDR PAST END OF LOW SEGMENT
00400 JRST DMPXC2 ;NO, GO AHEAD WITH LOW SEGMENT ADDR
00410 ADDI T2,1 ;POSSIBLE BEGINNING OF HIGH SEG
00420 CAIGE T2,400000 ;SKIP IF LOW SEG GT 400000
00430 MOVEI T2,400000 ;NO, HIGH SEG STARTS AT 400000
00440 CAMG T2,SAVADR ;SKIP IF ADDR BETWEEN SEGMENTS
00450 JRST DMPXC2 ;NO, GO AHEAD WITH HIGH SEG ADR
00460 MOVEM T2,SAVADR ;MOVE UP TO BEGINNING OF HIGH SEG
00470 JRST DMPXC0 ;AND START UP HIGH SEG
00480 DMPXC2: PUSHJ P,OUTPT ;OUTPUT IT
00490 JRST DMPXC0 ;AND LOOP FOR ALL BYTES REQUESTED
00010 DMPEX: POP P,C ;RESTORE LAST CHAR INPUT
00020 DMPEXA: JUMPLE C,DMPENX ;EXIT IF END OF LINE
00030 CAIE C,"'" ;SKIP IF STRING COMING
00040 JRST DMPBYS ;NO, GET NEXT DUMP DESCRIPTOR
00050 PUSHJ P,OPNOUT ;MAKE SURE OUTPUT FILE OPEN
00060 DMPEX1: JSP T2,DMPTTG ;GET NEXT CHAR OF STRING
00070 DMPEX2: CAIE C,C.DQ ;SKIP IF DOUBLE QUOTE
00080 JRST DMPEX3 ;NO, LOOK FOR SPECIAL PATTERN
00090 JSP T2,DMPTTG ;YES, TAKE NEXT CHAR LITERALLY
00100 JRST DMPEX8 ;AND OUTPUT IT
00110 DMPEX3: CAIN C,"'" ;SKIP IF NOT END OF STRING
00120 JRST DMPEXX ;ALL DONE, GET NEXT DUMP DESCRIPTOR
00130 CAIN C,"^" ;SKIP IF NOT CONTROL-LETTER
00140 JRST DMPEX6
00150 CAIN C,"\" ;SKIP IF NOT LOWER-CASE
00160 JRST DMPEX7
00170 CAIE C,"<" ;SKIP IF START OF SPECIAL PATTERN
00180 JRST DMPEX8 ;NO, JUST OUTPUT IT STRAIGHT
00190 PUSHJ P,.SIXSW ;GET NEXT GROUP OF ALPHNUMERICS
00200 CAIE C,">" ;SKIP IF REAL PATTERN
00210 JRST DMPEX5 ;NO, OUTPUT AS CHARS SEEN
00220 MOVSI T2,-LSPCHR
00230 MOVE M,N ;COPY SIXBIT VALUE
00240 HRR M,SPCHAR(T2) ;MAKE RH MATCH
00250 CAME M,SPCHAR(T2) ;SKIP IF MATCH PATTERN
00260 AOBJN T2,.-2 ;NO, TRY ALL LEGAL PATTERNS
00270 JUMPGE T2,DMPEX4 ;JUMP IF NOT LEGAL PATTERN
00280 HRRZ M,SPCHAR(T2) ;M=ADDR OF STRING ACTUALLY WANTED
00290 PUSH P,C ;SAVE C
00300 CAIN M,SPS.FF ;IS THIS A FORM FEED?
00310 JRST [PUSHJ P,NEWPAG ;YES--DO ALL THE CORRECT THINGS
00320 JRST .+2] ; AND SKIP OUTPUT
00330 PUSHJ P,LSTR ;OUTPUT THAT
00340 POP P,C ;PUT C BACK. IT SHOULD BE SUFFICIENT
00350 ; TO DO A MOVEI C," " HERE BUT WHY
00360 ; NOT DO IT RIGHT.
00370 JRST DMPEX1
00380 DMPEX4: MOVEI C,">" ;END WITH RIGHT ANGLE BRACKET
00390 DMPEX5: PUSH P,C ;SAVE TERMINATING CHAR
00400 MOVEI C,"<" ;WE KNOW THERE WAS A LEFT ANGLE BRACKET
00410 PUSHJ P,LCHR
00420 MOVE T2,N ;ALPHA CHARS WE READ
00430 PUSHJ P,LSIX ;TYPE THEM
00440 POP P,C ;NOW THE LAST CHAR
00450 JUMPLE C,DMPENX ;HANDLE UNEXPECTED EOL
00460 JRST DMPEX2 ;AND INVESTIGATE THAT
00010 DMPEX6: JSP T2,DMPTTG ;GET NEXT CHAR
00020 HRRZI C,-100(C) ;MAKE CONTROL LETTER
00030 CAIE C,"'"-100 ;SKIP IF END OF STRING
00040 JRST DMPEX8
00050 MOVEI C,"^" ;OUTPUT TERMINAL ^
00060 PUSHJ P,LCHR
00070 JRST DMPEXX ;AND EXIT
00080 DMPEX7: JSP T2,DMPTTG ;GET NEXT CHAR
00090 ADDI C,40 ;MAKE UPPER CASE
00100 CAIE C,"'"+40 ;SKIP IF END OF STRING
00110 JRST DMPEX8
00120 MOVEI C,"\" ;OUTPUT TERMINAL \
00130 PUSHJ P,LCHR
00140 DMPEXX: JSP T2,DMPTTG ;GT NEXT CHAR
00150 JUMPG C,DMPBYS ;KEEP GOING IF NOT END OF INPUT LINE
00160 DMPENX: TLNN F,L.OTTY ;SKIP IF OUTPUT DEVICE IS A TTY
00170 PJRST LCRLF ;NO, EXIT
00180 PUSHJ P,LCRLF ;YES, FINISH OFF LINE
00190 PJRST CLSFIL ;AND CLOSE TO GET THE OUTPUT TO THE USER NOW
00200
00210 DMPEX8: PUSHJ P,LCHR ;OUTPUT THE CHAR
00220 JRST DMPEX1 ;AND LOOK AT NEXT CHAR
00230
00240
00250 ;ROUTINE TO GET NEXT CHAR IN A STRING
00260
00270 DMPTTG: JUMPLE C,DMPENX ;EXIT IF EOL
00280 PUSHJ P,.TICHE## ;GET A BYTE BUT DO NOT PRE-PROCESS
00290 JUMPG C,(T2) ;RETURN WITH REAL BYTE
00300 JRST DMPENX ;EOL--EXIT
00010 DEFINE SPCTM(A)<IRP A,<XWD SIXBIT \ A\,SPS.'A>>
00020
00030 SPCHAR: SPCTM <EL,VT,FF,AL,HT>
00040 LSPCHR==.-SPCHAR
00050
00060 SPS.EL: ASCIZ .
00070 .
00080 SPS.VT: <C.VT_^D29>
00090 SPS.FF: <C.FF_^D29>
00100 SPS.AL: <C.ALT_^D29>
00110 SPS.HT: ASCIZ . .
00120
00130 BEGIN:
00140 CMPDMP:
00150 DELSYM:
00160 DOPROC:
00170 ENDPRC:
00180 IFPROC:
00190 IOFPRC:
00200 LISPRC:
00210 OOFPRC:
00220 POPPRC:
00230 PUSHPR:
00240 SYMPRC:
00250 TCMDMP:
00260 TSYMPR:
00270 JRST E.NIMP
00010 SUBTTL EVALUATE EXPRESSION
00020
00030 ;SUBROUTINE TO EVALUATE AN EXPRESSION
00040
00050 EXPEVA: PUSHJ P,EXPEV0 ;EVALUATE EXPRESSION
00060 MOVEM T1,SAVEXP ;STORE FOR %
00070 TLNN F,L.NXM ;EVALUATE OK?
00080 POPJ P, ;RETURN
00090 HRLZ N,ADRTMP ;PICK UP ADDRESS
00100 M.FAIO <NXM at> ;GIVE MESSAGE
00110
00120 EXPEV0: TRZ F,R.CONB!R.ANY ;NOTE NOT YET REQUIRED TO SEARCH FILE
00130 TLZ F,L.NXM ;CLEAR NXM FLAG
00140 JUMPLE C,.POPJ ;EXIT IF END OF LINE
00150 PUSHJ P,.SAVE2 ;PRESERVE P1 AND P2
00160 HRRZ P1,OPRTAB ;SET UP PTR TO OPERATOR STACK
00170 HRRZ P2,OPNTAB ;AND OPERAND STACK
00180 SUBI P1,1 ;MAKE PUSH DOWN PTR
00190 SUBI P2,1 ;MAKE PUSH DOWN PTR
00200 EXPEV1: PUSHJ P,EXPSYM ;GET NEXT SYMBOL
00210 JUMPE T1,EXPE2A ;ASSUME 0 IF A UNARY OPERATOR
00220 EXPEV2: TRNE F,R.RPN ;SKIP IF NOT AFTER RIGHT PAREN
00230 JRST E.EXP ;RIGHT PAREN MUST BE FOLLOWED BY UNARY OPERATOR
00240 TRO F,R.ANY ;NOTE SOMETHING FOUND
00250 EXPE2A: SETZ T2,
00260 TRZN F,R.RPN ;RIGHT PAREN SHOULD NOT PUSH 0
00270 PUSHJ P,PSHOPN ;PUT VALUE ON OPERAND STACK
00280 MOVSI T2,-LPRECL ;MINUS LENGTH OF PRECEDENCE TABLE
00290 CAIN C," " ;IF IT IS A BLANK TRY TO
00300 PUSHJ P,.TIAUC## ; GET A BETTER OPERATOR.
00310 CAIN C,C.DQ ;IS IT A DOUBLE QUOTE?
00320 MOVEI C,"W" ;YES--CONVERT TO DOUBLE-U
00330 CAIN C,"<" ;CONVERT LEFT ANGLE BRACKET TO "X" FOR
00340 MOVEI C,"X" ;INTERNAL EASE
00350 CAIN C,">" ;AND RIGHT ANGLE BRACKET TO "Y"
00360 MOVEI C,"Y"
00370 CAIE C,"," ; AND COMMA TO "Z" - SKIP IF COMMA SPECIFIED
00380 JRST EXPEV4 ;NO, GO AHEAD
00390 MOVEI C,"Z"
00400 TRZN F,R.CMAL ;SKIP IF COMMA LEGAL
00410 JRST EXPEOX ;NO, END OF EXPRESSION
00010 EXPEV4: HLL C,PRECLS(T2) ;LH C=PRECEDENCE OF NEXT SYMBOL ON LIST
00020 CAME C,PRECLS(T2) ;SKIP IF FOUND CHAR IN LIST
00030 AOBJN T2,EXPEV4 ;NO, TRY NEXT
00040 JUMPGE T2,EXPEOX ;EXIT IF TERMINATOR NOT OPERAND
00050 HRR C,T2 ;RH C=INDEX IN EXECUTION TABLE FOR THIS OPERAND
00060 HLLZ T2,C ;T2=PRECEDENCE ONLY
00070 EXPEV5: TLNE P1,-1 ;SKIP IF OPERATOR STACK EMPTY
00080 CAMLE T2,(P1) ;SKIP IF NEW OPERATOR LE STACK
00090 JRST NOUNST ;NO, DONT UNSTACK
00100 HLLZ T1,(P1) ;T1=PRECEDENCE OF OPERAND ON STACK
00110 CAML T2,T1 ;SKIP IF NEW LT STACK (NOT EQUAL)
00120 JRST EXPEV6 ;NEW EQ STACK
00130 CAMN T1,[XWD LPNPRE,0] ;SKIP IF STACK NOT LEFT PAREN
00140 CAMN T2,[XWD RPNPRE,0] ;SKIP IF NEW NOT RIGHT PAREN
00150 JRST EXPEV7 ;UNSTACK LEFT PAREN IF RIGHT PAREN
00160 JRST NOUNST ;ELSE DONT UNSTACK LEFT PAREN
00170 EXPEV6: CAME T2,[XWD LPNPRE,0] ;LEFT PAREN DOESN'T UNSTACK OTHER LEFT PAREN
00180 CAMN T2,[XWD FUNPRE,0] ;NOR DO FUNNIES UNSTACK EACH OTHER
00190 JRST NOUNST ;OTHERWISE EQUALS UNSTACK EACH OTHER
00200 EXPEV7: PUSHJ P,UNSTAK ;UNSTAK LAST OPERATOR ON STACK
00210 TLNE F,L.NXM ;NO SKIP IF NXM
00220 JRST EXPEX1 ;GIVE UP IF NXM
00230 TRNE F,R.RPN ;SKIP IF NOT RIGHT PAREN
00240 JRST EXPEV1 ;ALL DONE IF RIGHT PAREN
00250 JRST EXPEV5 ;AND LOOP TILL DONT UNSTACK
00260 NOUNST: HLRZ T2,C ;T2=PRECEDENCE OF NEW OPERATOR
00270 CAIN T2,RBKPRE ;SKIP IF NOT RIGHT ANGLE BRACKET
00280 TRO F,R.CMAL ;NOTE COMMA IS LEGAL AFTER ANGLE BRACKET
00290 HLRZ T1,P1 ;LENGTH OF OPERATOR STACK
00300 ADDI T1,1 ;+1=LENGTH NEEDED
00310 SUB T1,OPRLEN ;NEEDED-LENGTH=WORDS NEEDED TO ADD
00320 JUMPLE T1,NOUNS1 ;JUMP IF ALREADY LONG ENOUGH
00330 PUSH P,P2 ;SAVE P2
00340 MOVEI P2,OPRNDX ;INDEX IN TABLE VECTOR FOR OPERATOR STACK TABLE
00350 ADDI T1,4 ;GET SOME MORE ROOM
00360 ADDM T1,(P) ;FIX UP OTHER PUSH DOWN POINTER
00370 PUSHJ P,GETCOR ;EXPAND TABLE
00380 POP P,P2
00390 NOUNS1: PUSH P1,C ;PUT OPERATOR ON OPERATOR STACK
00400 JRST EXPEV1 ;AND GET NEXT OPERAND
00010 EXPEOX: TLNN P1,-1 ;SKIP IF MORE OPERATORS ON OPERATOR STACK
00020 JRST EXPEX1 ;NO MORE TO UNSTACK
00030 PUSHJ P,UNSTAK ;UNSTACK LAST OPERATOR
00040 TLNN F,L.NXM ;SKIP IF NXM
00050 JRST EXPEOX ;LOOP TILL ALL UNSTACKED
00060 EXPEX1: MOVE P1,P2
00070 MOVE T1,OPRLEN
00080 SUBI T1,4 ;KEEP MINIMAL LENGTH
00090 MOVEI P2,OPRNDX
00100 JUMPLE T1,EXPEX2 ;JUMP IF DONT HAVE ENOUGH TO GIVE SOME BACK
00110 SUBM T1,P1 ;FIX UP PUSH DOWN PTR
00120 MOVNS P1
00130 PUSHJ P,GIVCOR ;GIVE BACK EXCESS CORE
00140 EXPEX2: HRRES C ;RESTORE C TO ITS NATURAL SELF
00150 MOVE T1,OPNLEN
00160 SUBI T1,4
00170 MOVEI P2,OPNNDX
00180 CAILE T1,0 ;SKIP IF DONT HAVE MUCH
00190 PUSHJ P,GIVCOR ;GIVE BACK EXCESS CORE
00200 TLNE F,L.NXM ;NO SKIP IF NXM
00210 POPJ P,
00220 HLRZ T1,P1 ;LENGTH OF OPERAND STACK
00230 SUBI T1,2
00240 JUMPN T1,E.EXP ;JUMP IF NOT EXACTLY 1 ITEM ON STACK
00250 POP P1,T1 ;T1=VALUE
00260 POP P1,T2 ;T2=POSITION,SIZE WORD
00270 POPJ P,
00010 ;SUBROUTINE TO PUSH AN OPERAND ON THE OPERAND STACK
00020 ;ARGS T1=VALUE
00030 ; T2 BITS 0-5=POSITION+1
00040 ; T2 BITS 6-35=SIZE
00050
00060 PSHOPN: PUSH P,T1
00070 PUSH P,T2
00080 HLRZ T1,P2 ;CURRENT LENGTH OF OPERAND STACK
00090 ADDI T1,2 ;LENGTH NEEDED
00100 CAMGE T1,OPNLEN ;SKIP IF TABLE NOT BIG ENOUGH
00110 JRST PSHOP1 ;OK
00120 PUSH P,P2
00130 MOVEI P2,OPNNDX ;INDEX IN TABLE VECTOR
00140 ADDI T1,10 ;MAKE IT BIGGER
00150 PUSHJ P,GETCOR ;EXPAND TABLE
00160 POP P,P2
00170 PSHOP1: POP P,T2 ;RESTORE VALUE OF OPERAND
00180 POP P,T1
00190 PUSH P2,T2 ;PUSH OPERAND ON OPERAND STACK
00200 PUSH P2,T1 ;FIRST POSITION,SIZE, THEN VALUE
00210 POPJ P,
00220
00230 ;SUBROUTINE TO UNSTACK THE OPERATOR ON TOP OF THE OPERATOR STACK
00240
00250 UNSTAK: TLNN P2,-2 ;SKIP IF SOMETHING ON THE OPERAND STACK
00260 JRST E.EXP ;SIGH
00270 PUSH P,T2 ;SAVE T2
00280 POP P2,T1 ;LAST OPERAND
00290 POP P2,T2 ;POSITION,SIZE WORD
00300 HRRZ T3,(P1) ;INDEX IN INSTRUCTION TABLE
00310 XCT OPER(T3) ;EXECUTE INSTRUCTION FOR OPERATOR
00320 POP P1,T1 ;THROW AWAY OPERATOR
00330 POP P,T2 ;RESTORE T2
00340 POPJ P,
00010 DEFINE PRECMC<
00020 ZZ==1
00030 RPNPRE==ZZ
00040 X <)>
00050 X <+,->
00060 X <*,/>
00070 X <^>
00080 X <W>
00090 FUNPRE==ZZ
00100 X <[,@,\>
00110 RBKPRE==ZZ
00120 X <X,Y>
00130 X <Z>
00140 LPNPRE==ZZ
00150 X <(>
00160 >
00170
00180 DEFINE X(A)<
00190 IRP A,<
00200 XWD ZZ,"A">
00210 ZZ==ZZ+1
00220 >
00230
00240 PRECLS: PRECMC
00250 LPRECL==.-PRECLS
00010 DEFINE X(A)<
00020 ZZ==ZZ+1
00030 IRP A,<
00040 IFIDN <A> <+>,<
00050 PUSHJ P,EXPADD>
00060
00070 IFIDN <A> <->,<
00080 PUSHJ P,EXPSUB>
00090
00100 IFIDN <A> <*>,<
00110 IMULM T1,(P2)>
00120
00130 IFIDN <A> </>,<
00140 PUSHJ P,EXPDIV>
00150
00160 IFIDN <A> <^>,<
00170 PUSHJ P,EXPON>
00180
00190 IFIDN <A> <[>,<
00200 PUSHJ P,CONT36>
00210
00220 IFIDN <A> <@>,<
00230 PUSHJ P,CONT23>
00240 IFIDN <A> <\>,<
00250 PUSHJ P,CONT18>
00260
00270 IFIDN <A> <(>,<
00280 PUSHJ P,EXPRPN>
00290
00300 IFIDN <A> <)>,<
00310 JRST E.EXP>
00320
00330 IFIDN <A> <W>,<
00340 HLREM T1,(P2)>
00350
00360 IFIDN <A> <X>,<
00370 PUSHJ P,EXPRBK>
00380
00390 IFIDN <A> <Z>,<
00400 PUSHJ P,EXPCMA>
00410
00420 IFIDN <A> <Y>,<
00430 JRST E.EXP>
00440 >>
00010 OPER: PRECMC
00010 EXPADD: POP P2,T3 ;POP NEXT TO LAST OPERAND
00020 POP P2,T4
00030 PUSHJ P,ADDBYT ;ADD THE LAST TWO
00040 PUSH P2,T2 ;AND PUT THAT ON THE STACK
00050 PUSH P2,T1
00060 POPJ P,
00070
00080 EXPSUB: EXCH T1,(P2) ;LAST OPERAND ON STACK
00090 SUBM T1,(P2) ;SUBTRACT FROM NEXT TO LAST AND STORE ON STACK
00100 POPJ P,
00110
00120 EXPDIV: EXCH T1,(P2) ;LAST OPERAND ON STACK
00130 IDIVM T1,(P2) ;DIVIDE NEXT TO LAST BY LAST AND STORE ON STACK
00140 POPJ P,
00150
00160 EXPON: JUMPG T1,EXPON1 ;JUMP IF POSITIVE POWER
00170 MOVEI T1,1 ;ANYTHING TO NEGATIVE POWER IS 1
00180 SKIPE (P2) ;EXCEPT 0 WHICH IS 0
00190 MOVEM T1,(P2)
00200 POPJ P,
00210 EXPON1: MOVE T2,(P2) ;NUMBER TO BE RAISED TO A POWER
00220 EXPON2: SOJLE T1,.POPJ ;JUMP IF RAISED TO POWER DESIRED
00230 IMULM T2,(P2) ;RAISE TO ANOTHER POWER
00240 JRST EXPON2 ;AND LOOP TILL DONE
00250
00260 EXPCMA: TLNN P2,-2 ;SKIP IF SOMETHING ON OPERAND STACK
00270 JRST E.EXP ;ERROR IF OPERAND STACK EMPTY
00280 MOVEM T1,-1(P2) ;STORE SIZE
00290 MOVE T1,(P2) ;GET LAST OPERAND ON STACK=POSITION
00300 MOVEM T1,SIZTMP ;SAVE AS SIZE
00310 ADDI T1,1 ;MAKE LAST OPERAND=POSITION NON-ZERO
00320 LSH T1,POSSHF
00330 ORM T1,-1(P2) ;AND STORE AS POSITION OF OPERAND ON TOP OF STACK
00340 POPJ P,
00350
00360 EXPRBK: TRZN F,R.CMAL ;SKIP IF NO COMMA SEEN
00370 JRST EXPRB1 ;THIS IS A SIZE FIELD
00380 ADDI T1,1 ;IT IS POSITION, MAKE NON-ZERO
00390 LSH T1,POSSHF
00400 MOVE T2,T1 ;T2=POSITION, 0 FOR SIZE
00410 EXPRB1: MOVEM T2,-1(P2) ;STORE POSITION, SIZE FOR TOP OF STACK
00420 LSH T2,-POSSHF ;SHIFT BACK
00430 MOVEM T2,POSTMP ;STORE FOR LATER
00440 JRST EXPRP1 ;AND GET RID OF LEFT ANGLE BRACKET
00450
00460 EXPRPN: MOVEM T2,-1(P2) ;STORE OPERAND ON TOP OF 0 PUSHED FOR UNARY (
00470 MOVEM T1,(P2)
00480 EXPRP1: TRO F,R.RPN ;SET RIGHT PAREN BIT
00490 POPJ P,
00010 CONT18: PUSHJ P,FNDBYT ;GET CONTENTS OF WORD SPECIFIED
00020 TLZ T1,-1
00030 JRST CONTEX ;AND EXTRACT PROPER BYTE
00040
00050 CONT23: PUSHJ P,FNDBYT
00060 CON23A: TLNN T1,17 ;SKIP IF ANY INDEX SPECIFIED
00070 JRST NOINDX ;NO
00080 PUSH P,T1
00090 LDB T1,[POINT 4,T1,17] ;GET INDEX REGISTER
00100 PUSHJ P,FNDADR ;GET CONTENTS OF INDEX REGISTER
00110 POP P,T2
00120 TLNE F,L.NXM ;NO SKIP IF NXM
00130 JRST CONTEX
00140 EXCH T1,T2 ;T2=CONTENTS OF INDEX REGISTER
00150 ADDI T1,(T2)
00160
00170 INDBTS=(@) ;INDIRECT BITS
00180
00190 NOINDX: SETZ T2, ;CLEAR POSITION WORD IN CASE NO MORE INDIRECT
00200 TLZ T1,-1-INDBTS ;CLEAR ALL BUT INDIRECT BITS
00210 TLZN T1,(@) ;SKIP IF INDIRECT SPECIFIED
00220 JRST CONT36 ;ALL DONE IF NO MORE INDIRECTING
00230 MOVEM T1,ADRTMP ;NEW CURRENT ADDRESS
00240 PUSHJ P,FNDADR ;GET CONTENTS OF THAT LOCATION
00250 TLNN F,L.NXM ;SKIP IF NXM
00260 JRST CON23A ;AND LOOP TILL DONE
00270 JRST CONTEX
00280
00290 CONT36: PUSHJ P,FNDBYT ;GET CONTENTS OF WORD SPECIFIED
00300 CONTEX: MOVEM T1,(P2) ;STORE ON TOP OF ZERO PUSHED
00310 TRO F,R.CONB ;NOTE USED CONTENTS
00320 POPJ P,
00010 ;SUBROUTINE TO ADD TWO BYTE DESCRIPTORS
00020 ;ARGS T1,T2=BYTE DESCRIPTOR 1
00030 ; T3,T4=BYTE DESCRIPTOR 2
00040 ;VALUES T1,T2=BYTE DESCRIPTOR 1 + BYTE DESCRIPTOR 2
00050 ;BYTE DESCRIPTOR ADDITION IS DEFINED BY:
00060 ; ADDING ADDRESSES, THEN
00070 ; ADDING POSITION; IF OVERFLOWS THE WORD, TAKE PARTIAL BYTE FROM
00080 ; BOTH WORDS, THEN
00090 ; ADD SIZE INCREMENT TO POSITION; IF OVERFLOWS, RESET TO BEGINNING OF
00100 ; NEXT WORD, LIKE THE HARDWARE INCREMENTS BYTE POINTERS
00110
00120 ADDBYT: JOV .+1 ;CLEAR OVERFLOW
00130 ADD T1,T3 ;ADDRESSES ADD
00140 JUMPE T4,.POPJ ;NO CHANGE IF INCREMENT POS, SIZE=0
00150 PUSH P,T1
00160 LDB T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
00170 LDB T3,[POINT 36-POSSHF,T4,35-POSSHF] ;GET POSITION INCREMENT
00180 ADD T1,T3 ;T1=NEW POSITION
00190 SUBI T1,1 ;BOTH WERE +1, SO MAKE NEW +1
00200 ADDBY1: CAIGE T1,^D37 ;SKIP IF OVERFLOWED THE WORD
00210 JRST ADDBY2 ;NO, GO ADD SIZE
00220 AOS (P) ;BUMP ADDRESS TO NEXT WORD
00230 SUBI T1,^D36 ;AND MOVE POSITION BACK 36 BITS
00240 JRST ADDBY1 ;AND SEE IF INTO LAST WORD
00250 ADDBY2: TLZ T4,770000 ;CLEAR OUT POSITION FIELD
00260 ADD T1,T4 ;ADD INCREMENT SIZE TO POSITION
00270 MOVNS T4 ;-SIZE + BEGINNING OF NEXT
00280 ADDI T4,^D37 ;IS POSITION WHERE BYTE WILL OVERFLOW
00290 CAMG T1,T4 ;SKIP IF NEXT BYTE WILL OVERFLOW WORD
00300 JRST ADDBY3 ;NO, ALL SET
00310 MOVEI T1,1 ;RESET TO BEGINNING OF NEXT WORD
00320 AOS (P) ;BUMP ADDR
00330 ADDBY3: DPB T1,[POINT 36-POSSHF,T2,35-POSSHF] ;STORE NEW POSITION
00340 POP P,T1 ;POP FINAL ADDDRESS
00350 POPJ P,
00010 ;SUBROUTINE TO READ A SYMBOL
00020 ; T1=NUMBER IF NUMBER, RADIX50 SYMBOL IF SYMBOL
00030 ;RETURN .POPJ IF NUMBER
00040 ; .POPJ1 IF SYMBOL
00050
00060 REDSYM: SETZ T1,
00070 JUMPLE C,.POPJ1 ;EXIT IF END OF LINE
00080 PUSHJ P,.TIAUC ;GET NEXT CHAR
00090 CAIN C," " ;IGNORE BLANKS BEFORE A SYMBOL
00100 PUSHJ P,.TIAUC## ; TO MAKE DUMP EASIER TO USE.
00110 CAIL C,"0" ;SKIP IF NOT A NUMBER
00120 CAILE C,"9" ;SKIP IF A NUMBER
00130 JRST SYMIN ;ASSUME SYMBOL
00140 JRST RDXIN ;NUMBER, READ IN CURRENT INPUT RADIX
00150 SYMIN: CAIN C,"%" ;SKIP IF NOT PERCENT
00160 JRST SYMPER ;PERCENT IS LEGAL RADIX50 SYMBOL
00170 CAIN C,"$"
00180 JRST SYMDOL ;DOLLAR SIGN IS LEGAL RADIX50
00190 CAIN C,"."
00200 JRST SYMDOT ;AS IS DOT
00210 CAIL C,"A" ;SKIP IF NOT A LETTER
00220 CAILE C,"Z" ;SKIP IF LETTER
00230 JRST .+2
00240 JRST SYMLET ;LETTTER
00250 CAIL C,"0" ;SKIP IF NOT A NUMBER
00260 CAILE C,"9" ;SKIP IF A NUMBER
00270 JRST .POPJ1 ;NOT A RADIX50 SYMBOL, EXIT
00280 SYMNUM: SUBI C,"0"-1 ;"0" IS 1 IN RADIX50
00290 JRST SYMRD5 ;C=RADIX50 VALUE
00300 SYMPER: SKIPA C,[47] ;47 IS RADIX50 FOR PERCENT
00310 SYMDOL: MOVEI C,46 ;46 IS RADIX50 FOR DOLLAR SIGN
00320 JRST SYMRD5
00330 SYMDOT: SKIPA C,[45] ;45 IS RADIX50 FOR PERIOD
00340 SYMLET: SUBI C,"A"-13 ;"A" IS 13 IN RADIX50
00350 SYMRD5: IMULI T1,50
00360 ADD T1,C
00370 PUSHJ P,.TIAUC ;GET NEXT CHAR
00380 JRST SYMIN
00010 RDXIN: SETZ T1, ;CLEAR THE AC
00020 JOV RDXIN1 ;CLEAR THE OVERFLOW FLAG
00030 RDXIN1: SUBI C,"0"
00040 CAIL C,0 ;SEE IF IN RADIX
00050 CAML C,IRADIX ;SKIP IF A NUMBER IN CURRENT RADIX
00060 JRST RDXMUL ;END OF NUMBER
00070 IMUL T1,IRADIX ;MULTIPLY PREVIOUS BY CURRENT RADIX
00080 ADD T1,C ;+ THIS NUMBER
00090 JOV [TLO T1,(1B0) ;OVERFLOW DOES NOT TAKE PLACE
00100 JRST .+1] ; SO SET BIT ZERO TO MAKE IT HAPPEN
00110 ADDI C,"0" ;FIX CHAR BACK UP FOR CONKLIN
00120 PUSHJ P,.TIAUC ;GET NEXT CHAR
00130 JRST RDXIN1 ;AND LOOP
00140
00150 RDXMUL: ADDI C,"0" ;RESET CHAR
00160 POPJ P,
00010 SUBTTL GET BYTE FROM INPUT FILE
00020
00030 ;SUBROUTINE TO EXTRACT A BYTE FROM THE INPUT FILE
00040 ;ARGS T1=ADDRESS OF WORD DESIRED
00050 ; T2=POSITION, SIZE DESIRED
00060
00070 FNDBYT: PUSHJ P,.SAVE2 ;SAVE P1,P2
00080 MOVEM T1,ADRTMP ;SAVE ADDRESS
00090 LDB T1,[POINT 36-POSSHF,T2,35-POSSHF] ;GET POSITION
00100 CAIN T1,0 ;SKIP IF SPECIFIED
00110 MOVEI T1,1 ;NO, ASSUME 0 (+OFFSET)
00120 MOVEM T1,POSTMP ;SAVE POSITION
00130 TLZ T2,770000
00140 MOVEI T1,^D36 ;DEFAULT IS FULL WORD
00150 CAIN T2,0 ;SKIP IF SIZE SPECIFIED
00160 MOVE T2,T1 ;USE DEFAULT
00170 MOVEM T2,SIZTMP
00180 MOVEI P2,BYTNDX ;INDEX IN TABLE VECTOR FOR BYTE TABLE
00190 MOVE T1,T2 ;T1=SIZE IN BITS
00200 ADDI T1,^D35
00210 IDIVI T1,^D36 ;CONVERT TO WORDS
00220 SUB T1,BYTLEN ;SEE IF TABLE LONG ENOUGH
00230 JUMPLE T1,FNDBY1 ;JUMP IF BIG ENOUGH, GET RID OF EXCESS
00240 PUSHJ P,GETCOR ;EXPAND TABLE
00250 JRST FNDBY2
00260 FNDBY1: JUMPE T1,FNDBY2 ;JUMP IF EXACTLY RIGHT SIZE
00270 MOVNS T1 ;T1=EXCESS
00280 PUSHJ P,GIVCOR ;GIVE BACK EXCESS
00290 FNDBY2: MOVE P1,BYT.Y ;BYTE POINTER FOR STORING BYTE
00300 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00310 MOVE T1,ADRTMP ;ADDRESS OF WORD TO FETCH
00320 PUSHJ P,FNDADR ;GET FIRST WORD
00330 TLNE F,L.NXM ;NO SKIP IF NXM
00340 POPJ P,
00350 MOVE T2,POSTMP ;POSITION
00360 ADD T2,SIZTMP ;+SIZE
00370 CAILE T2,^D37 ;SKIP IF LE 1 WORD
00380 JRST FNDBY3 ;OVERFLOWS THE WORD
00390
00400 ;HERE IF ALL IN THIS WORD
00410
00420 MOVE T3,POSTMP ;POSITION
00430 LSH T1,-1(T3) ;BITS TO TOP OF T1
00440 SUBI T2,^D36(T3) ;BITS TO SHIFT RIGHT=36-SIZE
00450 LSH T1,(T2) ;NOW TO BOTTOM
00460 JRST FNDBYX ;STORE LAST WORD AND EXIT
00010 ;HERE IF SPLIT OVER WORD BOUNDARY
00020
00030 FNDBY3: MOVE T2,SIZTMP ;GET SIZE
00040 CAILE T2,^D36 ;SKIP IF BYTE FITS IN 1 WORD
00050 JRST FNDBY4 ;MORE THAN 36 BITS REQUIRED
00060 PUSH P,T1 ;SAVE FIRST WORD
00070 AOS T1,ADRTMP ;ADDR OF NEXT WORD
00080 PUSHJ P,FNDADR ;GET SECOND WORD
00090 POP P,T2 ;RESTORE FIRST WORD
00100 MOVE T3,POSTMP ;POSITION
00110 LSHC T1,^D36(T3) ;SHIFT TO TOP OF T1
00120 MOVE T3,SIZTMP ;SIZE
00130 SUBI T3,^D36 ;-36=BITS TO SHIFT RIGHT
00140 LSH T1,(T3) ;SHIFT TO BOTTOM OF T1
00150 SOS ADRTMP ;RESTORE REAL ADDRESS
00160 JRST FNDBYX ;STORE BYTE AND EXIT
00010 ;HERE IF MORE THAN 36 BITS REQUIRED
00020
00030 FNDBY4: PUSH P,SIZTMP ;SAVE SIZE
00040 PUSH P,ADRTMP ;AND ADDRESS
00050 FNDBY5: PUSH P,T1 ;SAVE CURRENT 36 BITS
00060 AOS T1,ADRTMP ;ADDRESS OF NEXT WORD
00070 PUSHJ P,FNDADR ;GET NEXT 36 BITS
00080 POP P,T2 ;RESTORE PREVIOUS 36 BITS
00090 TLNE F,L.NXM ;NO SKIP IF NXM
00100 POPJ P,
00110 MOVE T3,POSTMP ;POSITION
00120 LSHC T1,^D36(T3) ;SHIFT TO TOP OF T1
00130 MOVE T4,SIZTMP ;SIZE
00140 SUBI T4,^D36 ;MINUS THESE 36 BITS
00150 JUMPG T4,FNDBY6 ;JUMP IF MORE TO COME
00160 POP P,ADRTMP ;THIS IS THE LAST, RESTORE ADDRESS
00170 POP P,SIZTMP
00180 JRST FNDBYX ;STORE LAST WORD AND EXIT
00190
00200 FNDBY6: MOVEM T4,SIZTMP ;STORE BITS LEFT TO GET
00210 PUSHJ P,STOBYT ;STORE THESE 36 BITS
00220 MOVNS T3 ;MINUS POSITION
00230 ADDI T3,^D36 ;+36=BITS TO SHIFT TO SAVE REST OF SECOND WORD
00240 LSHC T1,(T3) ;SAVE PART OF SECOND WORD NOT YET USED
00250 JRST FNDBY5 ;LOOP TILL LAST WORD
00260
00270 FNDBYX: PUSHJ P,STOBYT ;STORE LAST BYTE
00280 MOVE P1,BYT.Y
00290 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00300 ILDB T1,P1 ;GET FIRST 36 BITS
00310 POPJ P,
00010 ;SUBROUTINE TO GET A WORD FROM THE INPUT FILE
00020 ;ARGS T1=ADDRESS OF WORD DESIRED
00030 ;VALUES T1=CONTENTS OF WORD DESIRED
00040 ; BIT L.NXM OF F SET IF NXM
00050
00060 FNDADR: JUMPL T1,RETNXM ;NEGATIVE ADDRESSES ARE NOT IN FILE
00070 PUSHJ P,.SAVE2 ;SAVE P1,P2
00080 TLNN DL,DL.SYM ;SKIP IF READING SYMBOLS
00090 PUSHJ P,CMPOFF ;OFFSET IF NECESSARY THE ADDRESS TO FIND
00100 MOVEM T1,TEMPAD ;ACTUAL ADDRESS TO FETCH
00110 TLZ F,L.NXM ;CLEAR NXM FLAG
00120 FNDAD1: SKIPG T1,%TYP(DL) ;SKIP IF TYPE OF INPUT FILE KNOWN
00130 JRST NOTYP ;NO, TRY TO FIND OUT
00140 SUBI T1,1
00150 HLLZS %EXT(DL) ;CLEAR MASK
00160 SKIPN T2,%EXT(DL) ;SKIP IF NO EXT KNOWN YET
00170 HLLZ T2,I.DEX(T1) ;NO, GET DEFAULT
00180 MOVEM T2,%EXT(DL)
00190 ROT T1,-1 ;DIVIDE BY 2
00200 MOVE T2,TYPVEC(T1) ;DISPATCH ADDRESS
00210 CAIL T1,0 ;SKIP IF WANT RIGHT HALF
00220 MOVSS T2 ;NO, WANT ADDR IN LH
00230 JRST (T2) ;CALL ROUTINE TO FIND WORD
00240
00250 ;HERE IF TYPE OF INPUT FILE NOT KNOWN, TRY TO FIND OUT BY ITS EXTENSION
00260
00270 NOTYP: PUSHJ P,.SAVE1 ;SAVE P1
00280 MOVEI P1,(DL) ;POINTER TO FILE SPEC
00290 PUSHJ P,GETSPC ;PICK UP STICKY DEFAULTS
00300 MOVE T1,%DEV(DL) ;INPUT DEVICE
00310 DEVCHR T1,
00320 TLNN T1,DV.DIR ;SKIP IF A DIRECTORY DEVICE
00330 JRST NOTYPD ;NO, USE DEFAULT
00340 MOVEI T1,17 ;DIRECTORY DEVICE, LOOK FOR EXTENSIONS
00350 MOVE T2,%DEV(DL)
00360 SETZ T3,
00370 OPEN IC,T1
00380 JRST E.LKO ;CANT OPEN INPUT DEVICE
00390 SKIPE T2,%EXT(DL) ;SKIP IF NO EXT SPECIFIED
00400 JRST EXTTYP ;LOOK AT EXT SPECIFIED
00410 MOVSI P1,-I.LDEX
00420 MOVE T1,%NAM(DL) ;NAME OF INPUT FILE
00430 SETZ T3,
00440 NOTYP1: HLLZ T2,I.DEX(P1) ;NEXT EXT TO TRY
00450 PUSHJ P,SETPTH ;SET UP PATH OR PPN IN T4
00460 LOOKUP IC,T1
00470 AOBJN P1,NOTYP1 ;NO SUCH FILE, TRY NEXT
00480 JUMPGE P1,E.NSFI ;JUMP IF CANT FIND ANY FILES
00490 HLLM T2,%EXT(DL) ;STORE EXT USED
00500 HRROI T1,1(P1) ;T1=TYPE
00510 JRST EXTTY2 ;GO STORE TYPE
00010 ;HERE IF EXTENSION SPECIFIED
00020
00030 EXTTYP: MOVE T1,%NAM(DL)
00040 SETZ T3,
00050 PUSHJ P,SETPTH ;SET UP PATH OR PPN IN T4
00060 LOOKUP IC,T1
00070 JRST E.NSFI
00080 HLLM T2,%EXT(DL)
00090 MOVSI T1,-I.LDEX
00100 EXTTY1: HRR T2,I.DEX(T1) ;LOOK FOR EXTENSION ON LIST
00110 CAME T2,I.DEX(T1) ;SKIP IF FOUND IT
00120 AOBJN T1,EXTTY1
00130 ADDI T1,1
00140 EXTTY2: MOVEI T2,T.TMP
00150 CAIN T2,(T1) ;SKIP IF NOT TMP FILE
00160 HRRZ T2,%NAM(DL) ;TYPE FROM NAME OF FILE
00170 CAIN T2,(SIXBIT .DAE.) ;SKIP IF NOT DAEMON FILE
00180 HRROI T1,T.DAE ;NNNDAE.TMP IS A DAEMON FILE
00190 CAIL T1,0 ;SKIP IF FOUND ONE
00200 NOTYPD: MOVEI T1,AD.TYP ;DEFAULT
00210 HRRZM T1,%TYP(DL)
00220 JRST FNDAD1
00010 ;SUBROUTINE TO FIND A WORD IN A DAEMON FILE
00020
00030 FNDDAE: TLNN F,L.IOPN ;INPUT OPEN?
00040 PUSHJ P,OPNDAE ;NO--GO SET UP FILE
00050 FNDDA0: PUSHJ P,.SAVE1 ;SAVE P1
00060 MOVE T1,CATNUM ;CATEGORY DESIRED FOR THIS BYTE
00070 EXCH T1,DAECCT ;STORE AS CURRENT CATEGORY AND SAVE LAST
00080 CAMN T1,DAECCT ;SKIP IF WAS NOT AT THAT CATEGORY
00090 JRST FNDDA5 ;ALREADY IN THE CATEGORY
00100 SETZM CATBLK ;REWIND THE DAEMON FILE AND SCAN
00110 SETZM CATWRD ; FROM THE START.
00120 FNDDA3: AOS T1,CATBLK ;SET BEGINNING OF CATEGORY TO BLOCK 1 OF FILE
00130 MOVEM T1,DAECBK ;REMEMBER CURRENT BLOCK
00140 USETI IC,(T1) ;START AT THAT BLOCK
00150 INPUT IC,INPLST ;READ THE BLOCK
00160 SETZB T2,DAECWD ;CLEAR CURRENT WORD IN BLOCK
00170 PUSHJ P,CATRW1 ;SET UP BEGINNING OF CATEGORY
00180 MOVE T2,DMHEAD ;T2=ADDRESS OF NEXT WORD IN INPUT BUFFER
00190 MOVE T1,(T2) ;GET CATEGORY NUMBER
00200 FNDDA1: CAMN T1,DAECCT ;SKIP IF NOT CATEGORY DESIRED
00210 JRST FNDDA2 ;POSITIONED AT BEGINNING OF CATEGORY
00220 PUSHJ P,READDM ;GET LENGTH
00230 TLNE F,L.IEOF ;END OF FILE
00240 PJRST RETNXM ;YES--RETURN NXM
00250 MOVE P1,T1
00260 FNDDA4: PUSHJ P,READDM
00270 SOJGE P1,FNDDA4 ;READ PAST CATEGORY
00280 JRST FNDDA1
00290 FNDDA2: PUSHJ P,READDM ;READ LENGTH OF CATEGORY
00300 MOVE T2,DAECBK ;CURRENT BLOCK NUMBER
00310 IMULI T2,WINSIZ ;CONVERTED TO WORDS
00320 ADD T2,DAECWD ;PLUS CURRENT WORD NUMBER
00330 SUBI T2,WINSIZ-1 ;- ONE BLOCK+1=OFFSET FROM BEGINNING OF FILE
00340 ADD T1,T2 ;PLUS LENGTH OF CAT=OFFSET OF LAST WORD OF CAT+1
00350 MOVEM T1,CATLEN ;STORE LAST WORD OF CATEGORY
00360 MOVNM T2,HGHOFF ;AND OFFSET FOR BEGINNING OF CATEGORY
00370 MOVEI T1,CATBLK-1
00380 PUSH T1,DAECBK
00390 PUSH T1,DAECWD
00010 ;HERE WHEN SOMEWHERE IN CATEGORY
00020
00030 FNDDA5: MOVE T1,TEMPAD ;ADDRESS DESIRED
00040 MOVE T2,CATNUM ;CATEGORY
00050 CAIN T2,CA.COR ;CORE??
00060 JRST FNDDA6 ;YES--GO DO IT
00070 CAMGE T1,WINADR ;IN THIS WINDOW?
00080 PUSHJ P,CATREW ;NO--REWIND
00090 JRST DATRED ;READ AS DATA
00100
00110 ;HERE IF CORE
00120
00130 FNDDA6: TLNE T1,-1 ;BITS IN LEFT HALF?
00140 JRST RETNXM ;YES--NOT IN FILE
00150 TLNE DL,DL.ANXM ;DO AC'S EXIST
00160 JRST RETNXM ;NO--DUMB DUMP
00170 TLNN F,L.IOPN ;INPUT SETUP?
00180 JRST FNDDA7 ;NO--CAN NOT TRUST JOBDAT
00190 TRNN T1,777600 ;LESS THAN 200(8)
00200 TLNE DL,DL.SYM ;READING SYMBOLS?
00210 JRST FNDDA7 ;YES--DO NOT USE BUFFER IT IS WRONG
00220 JRST [MOVE T1,JOBDAT(T1) ;YES--RETURN DATA FROM BUFFER
00230 POPJ P,] ; ..
00240 MOVEI T2,.JBREL## ;DUMB LOADER
00250 CAMG T1,JOBDAT(T2) ;SKIP IF NOT IN LOWSEG
00260 JRST FNDDA7 ;IN LOWSEG GO READ
00270 CAIL T1,400000 ;SKIP IF IN HISEG
00280 JRST RETNXM ;BETWEEN SEGMENTS RETURN NXM
00290 FNDDA7: CAMGE T1,WINADR ;BELOW THIS WINDOW
00300 PUSHJ P,CATREW ;YES--REWIND FILE
00310 JRST CMPRED ;READ CORE IMAGE
00010 ;HERE TO SET UP DAEMON FILE
00020
00030 OPNDAE: PUSHJ P,OPNDMP ;OPEN THE FILE
00040 TLNE DL,DL.SYM ;READING THE SYMBOL FILE
00050 POPJ P, ;YES--RETURN WITHOUT BUFFERING
00060 TLZ F,L.IOPN ;CLEAR THE BIT FOR NOW
00070 TLZ DL,DL.ANXM ;CLEAR CORE 0 BIT
00080 PUSHJ P,.SAVE1## ;SAVE P1
00090 PUSH P,CATNUM ;SAVE CATEGORY
00100 PUSH P,TEMPAD ;SAVE ADDRESS
00110 MOVEI T1,CA.COR ;MAKE IT LOOK LIKE CORE
00120 MOVEM T1,CATNUM ; ..
00130 MOVSI P1,-200 ;SIZE OF JOBDAT BUFFER
00140 SETZM TEMPAD ;CLEAR TEMP POINTER
00150 SETZM DAECCT ;CLEAR ALL RECOLECTIONS OF
00160 SETZM CATBLK ; LIFE IN THE PAST.
00170 SETZM CATWRD
00180 HRLOI T1,377777 ;CAUSE THE WINDOW TO BE
00190 MOVEM T1,WINADR ; WASHED.
00200 OPNDA1: PUSHJ P,FNDDA0 ;GET THE WORD
00210 MOVEM T1,JOBDAT(P1) ;STORE
00220 TLNE F,L.NXM ;NXM??
00230 TLO DL,DL.ANXM ;YES -- NO CORE ASSIGNED
00240 AOS TEMPAD ;ADVANCE POINTER
00250 AOBJN P1,OPNDA1 ;LOOP FOR MORE
00260 POP P,TEMPAD ;RESTORE LOCALS
00270 POP P,CATNUM ; ..
00280 TLO F,L.IOPN ;OPEN NOW
00290 POPJ P, ;RETURN
00010 ;SUBROUTINE TO FIND A WORD IN AN EXPANDED FILE
00020
00030 FNDXPN:
00040
00010 ;SUBROUTINE TO FIND A WORD IN A DATA FILE
00020
00030 FNDTMP:
00040 FNDDAT: SETZM HGHOFF ;OFFSET=ZERO
00050 PUSHJ P,OPNDMP ;OPEN INPUT FILE IN DUMP MODE
00060 PJRST DATRED ;AND FIND WORD
00070
00080 ;SUBROUTINE TO FIND A WORD IN A HIGH SEGMENT FILE
00090
00100 FNDHGH:
00110 FNDSHR: TLNE F,L.IOPN ;SKIP IF INPUT NOT YET OPEN
00120 PJRST DATRED
00130 PUSHJ P,OPNDMP ;OPEN INPUT FILE IN DUMP MODE
00140 MOVEI T2,.JBHCR ;WORD WHICH CONTAINS LOW SEG SIZE
00150 PUSHJ P,READDM ;READ UP TO .JBHCR
00160 SOJGE T2,.-1
00170 HRRZS T1 ;RH=SIZE OF LOW SEGMENT
00180 ADDI T1,1777
00190 TRZ T1,1777 ;ROUND UP TO NEXT K
00200 CAIGE T1,400000 ;WHICH IS START OF HIGH SEG
00210 MOVEI T1,400000 ;BUT MUST BE AT LEAST 400000
00220 MOVEM T1,HGHOFF ;OFFSET FOR HIGH SEGMENT
00230
00240 ;HERE WHEN INPUT FILE OPEN AND OFFSET KNOWN
00250
00260 ; PJRST DATRED
00270 ;SUBROUTINE TO READ A WORD FROM A DATA FILE
00280 ;ARGS TEMPAD=ADDRESS OF WORD TO GET
00290 ; HGHOFF=ADDRESS OFFSET FOR FIRST WORD OF FILE
00300 ;VALUES T1=CONTENTS OF WORD DESIRED
00310
00320 DATRED: MOVE T1,TEMPAD ;ADDRESS DESIRED
00330 SUB T1,HGHOFF ;-OFFSET=WORD NUMBER IN FILE
00340 JUMPL T1,RETNXM ;RETURN NXM IF NOT THERE
00350 CAML T1,CATLEN ;SKIP IF NOT PAST END OF FILE
00360 PJRST DATRD1 ;NXM
00370 SUB T1,WINADR ;SUBTRACT ADDRESS OF BEGINNING OF WINDOW
00380 JUMPL T1,DATRD2 ;JUMP IF WINDOW PAST LOCATION
00390 CAIL T1,WINSIZ ;SKIP IF IN CURRENT BLOCK
00400 JRST DATRD2 ;NO, READ UP TO IT
00410 SKIPA T1,WINDOW(T1) ;GET WORD
00420 DATRD1: TLO F,L.IEOF!L.NXM ;END OF FILE
00430 POPJ P, ;AND EXIT
00440 DATRD2: ADD T1,WINADR ;ADDRESS DESIRED
00450 LSH T1,-7 ;CONVERT TO BLOCK NUMBER
00460 USETI IC,1(T1) ;SET TO READ THAT BLOCK
00470 LSH T1,7 ;RESET TO WORD ADDRESS OF BEGINNING OF BLOCK
00480 MOVEM T1,WINADR ;AND REMEMBER THAT AS THE START OF THE WINDOW
00490 IN IC,WINLST
00500 JRST DATRED
00510 PUSHJ P,DATRED ;T1 _ WORD (MAY BE JUNK)
00520 JRST READDE
00010 ;SUBROUTINE TO FIND A WORD IN A LOW OR SAVE FILE
00020
00030 FNDLOW:
00040 FNDSAV: TLNE F,L.IOPN ;SKIP IF INPUT FILE NOT YET OPEN
00050 JRST FNDSV1
00060 PUSHJ P,OPNDMP ;OPEN INPUT FILE IN DUMP MODE
00070 PUSHJ P,CATRW2 ;SET UP FOR READING
00080 FNDSV1: MOVE T1,TEMPAD ;ADDRESS DESIRED
00090 CAMGE T1,WINADR ;SKIP IF NOT YET TO ADDR
00100 PUSHJ P,SAVREW ;REWIND SAVE FILE
00110 ; PJRST CMPRED ;READ WORD FROM COMPRESSED FILE
00120
00130 ;SUBROUTINE TO FIND A WORD IN A COMPRESSED FILE
00140 ;ARGS T1=TEMPAD=ADDRESS OF WORD
00150 ;VALUES T1=CONTENTS OF WORD
00160 ; L.NXM BIT OF F SET IF NXM
00170 ;NOTE: CALL WITH T1 .GE. WINADR. CALL SAVREW OR CATREW AS NEEDED
00180 ; TO MEET THIS RESTRICTION.
00190
00200 CMPRED: SUB T1,WINADR ;INDEX OF WORD RELATIVE TO CURRENT WINDOW
00210 CAIGE T1,WINSIZ ;SKIP IF NOT IN WINDOW
00220 JRST CMPRD1 ;THE DESIRED WORD IS IN THE WINDOW
00230 PUSHJ P,REDWIN ;READ NEXT WINDOW
00240 MOVE T1,TEMPAD ;RESTORE ADDRESS DESIRED
00250 TLNN F,L.IEOF ;SKIP IF NXM
00260 JRST CMPRED ;LOOP TILL FIND PROPER WINDOW
00270 SUB T1,WINADR ;INDEX OF WORD IN WINDOW
00280 CMPRD1: CAMLE T1,WINLEN ;SKIP IF WORD REALLY CONTAINS DATA
00290 RETNXM: TLOA F,L.NXM ;NO, PAST END OF DATA
00300 MOVE T1,WINDOW(T1) ;RETURN WORD DESIRED
00310 POPJ P,
00010 FNDDDI:
00020 FNDDEC:
00030 FNDDMP:
00040 FNDSDS:
00050 POPJ P,
00010 ;SUBROUTINE TO FILL NEXT WINDOW
00020
00030 REDWIN: MOVEI T2,WINSIZ ;SIZE OF WINDOW
00040 MOVEM T2,WINLEN ;ASSUME FULL WINDOW TO BE STORED
00050 ADDB T2,WINADR ;NEW ADDRESS OF BEGINNING OF WINDOW
00060 SETZM WINDOW
00070 MOVE T1,[XWD WINDOW,WINDOW+1]
00080 BLT T1,WINDOW+WINSIZ-1 ;CLEAR WINDOW TO START
00090 REDWN1: SKIPGE T3,CURIOW ;SKIP IF OLD IOWD EXHAUSTED
00100 JRST REDWN2
00110 PUSHJ P,READDM ;READ NEXT IOWD
00120 MOVEM T1,CURIOW ;SAVE IOWD
00130 JUMPL T1,REDWN1 ;JUMP IF REAL IOWD
00140 SUB T2,WINADR ;T2=ADDR IN WINDOW OF LAST WORD STORED
00150 MOVEM T2,WINLEN
00160 TLO F,L.IEOF ;NOTE END OF INPUT FILE
00170 POPJ P,
00180 REDWN2: MOVEI T1,1(T3) ;T1=ADDR OF NEXT PIECE FROM FILE
00190 HRRZ T2,T3
00200 CAIE T2,-1 ;SKIP IF ADDR = -1
00210 JRST REDWN5 ;OK
00220 AOSN T3 ;AOBJP WORKS FUNNY BECAUSE OF OVERFLOW
00230 SOSA T3 ;BUT IF WAS -1 POP LOSES
00240 POP T3,T2 ;SO MAKE IT COME OUT RIGHT AFTER FIRST
00250 REDWN5: MOVE T2,WINADR ;ADDRESS OF FIRST LOCATION IN WINDOW
00260 SUBM T1,T2 ;T2=INDEX INTO WINDOW
00270 CAIL T2,WINSIZ ;SKIP IF PIECE STARTS IN THIS WINDOW
00280 POPJ P, ;NO, WINDOW IS BETWEEN PIECES, ALL ZERO
00290 HRLI T2,-WINSIZ(T2)
00300 REDWN3: PUSHJ P,READDM
00310 MOVEM T1,WINDOW(T2) ;STORE NEXT WORD
00320 AOBJP T3,REDWN4 ;EXIT IF END OF PIECE FROM INPUT FILE
00330 AOBJN T2,REDWN3 ;LOOP TILL WINDOW FULL
00340 MOVEM T3,CURIOW ;SAVE IOWD FOR REST OF PIECE FROM FILE
00350 POPJ P,
00360 REDWN4: HRRZ T2,T3 ;T2=LAST ADDRESS STORED
00370 SETZM CURIOW ;NOTE IOWD EXHAUSTED
00380 JRST REDWN1 ;GET NEXT PIECE
00010 ;SUBROUTINE TO REWIND A SAVE FILE
00020 ;SAVES T1
00030
00040 SAVREW: MOVEM T1,CURIOW ;SAVE T1, CURIOW CLOBBERED HERE ANYWAY
00050 USETI IC,1 ;SET TO READ FIRST BLOCK OF FILE
00060 SETZM DMHEAD ;SET TO RECOMPUTE HEADER
00070 JRST CATRW2 ;FINISH UP
00080
00090 ;SUBROUTINE TO REWIND THE CURRENT CATEGORY FOR DAEMON FILES
00100
00110 CATREW: MOVEM T1,CURIOW ;SAVE T1, CURIOW CLOBBERRED HERE ANYWAY
00120 MOVE T1,CATBLK ;BLOCK OF BEGINNING OF CATEGORY
00130 MOVEM T1,DAECBK ;REMEMBER CURRENT BLOCK
00140 USETI IC,(T1)
00150 INPUT IC,INPLST
00160 HRRZ T2,CATWRD
00170 MOVEM T2,DAECWD ;REMEMBER CURRENT WORD IN BLOCK
00180 CATRW1: HRLS T2
00190 ADD T2,[XWD -200,IBUF]
00200 MOVEM T2,DMHEAD
00210 CATRW2: MOVNI T1,WINSIZ
00220 MOVEM T1,WINADR
00230 MOVE T1,CURIOW ;RESTORE T1
00240 SETZM CURIOW ;NOTE NO IOWD READY
00250 TLZ F,L.IEOF ;CLEAR EOF FLAG
00260 POPJ P,
00010 ;SUBROUTINE TO READ NEXT WORD FROM INPUT FILE IN DUMP MODE
00020
00030 READDM: TLNE F,L.IEOF ;SKIP IF END OF FILE
00040 POPJ P,
00050 AOS DAECWD ;COUNT WORDS READ
00060 MOVE T1,DMHEAD
00070 AOBJN T1,READD1
00080 INPUT IC,INPLST
00090 STATZ IC,760000 ;SKIP IF NO ERRORS
00100 JRST READDE
00110 AOS DAECBK
00120 SETZM DAECWD
00130 MOVE T1,[XWD -200,IBUF]
00140 READD1: MOVEM T1,DMHEAD
00150 MOVE T1,(T1)
00160 POPJ P,
00170
00180 READDE: GETSTS IC,N
00190 TRNE N,IO.EOF ;SKIP IF NOT END OF FILE
00200 JRST READEO
00210 M.FAIO <INPUT ERROR STATUS =>
00220
00230 READEO: TLO F,L.IEOF
00240 POPJ P,
00010 ;SUBROUTINE TO OPEN THE INPUT FILE IN DUMP MODE
00020
00030 OPNDMP: TLNE F,L.IOPN ;SKIP IF NOT YET OPEN
00040 POPJ P, ;ALREADY OPEN
00050 PUSHJ P,.SAVE1## ;SAVE P1
00060 MOVE P1,(DL) ;POINT TO SPEC
00070 PUSHJ P,GETSPC ;GET STICKEY DEFAULTS
00080 MOVEI T1,17 ;DUMP MODE
00090 MOVE T2,%DEV(DL) ;INPUT DEVICE
00100 SETZ T3,
00110 OPEN IC,T1
00120 JRST E.LKO ;NO SUCH DEVICE
00130 MOVE T1,%NAM(DL) ;NAME OF INPUT FILE
00140 SETZB T3,DMHEAD
00150 OPNDM1: MOVE T2,%EXT(DL) ;EXTENSION
00160 PUSHJ P,SETPTH ;SET UP PATH OR PPN IN T4
00170 LOOKUP IC,T1
00180 JRST OPNDM2 ;TRY NULL EXTENSION IF NONE SPECIFIED
00190 HLRE T1,T4 ;T1=LENGTH OF FILE
00200 JUMPLE T1,.+2 ;JUMP IF WORDS
00210 LSH T1,7 ;CONVERT BLOCKS TO WORDS
00220 MOVMM T1,CATLEN ;STORE +LENGTH OF FILE IN WORDS
00230 TLO F,L.IOPN ;NOTE INPUT FILE OPEN
00240 HRLOI T1,377777 ;WE HAVE NEVER READ THE WINDOW
00250 MOVEM T1,WINADR ; SO CAUSE US TO READ ON THE NEXT
00260 ; TRY.
00270 POPJ P, ;AND EXIT
00280 OPNDM2: MOVE T4,%EXT(DL)
00290 TRNE T4,-1 ;SKIP IF NO EXT WAS SPECIFIED
00300 JRST E.NSFI ;THERE WAS, CANT FIND FILE SPECIFIED
00310 HRLOM T4,%EXT(DL)
00320 JRST OPNDM1 ;TRY NULL
00010 ;SUBROUTINE TO COMPUTE OFFSET FOR AN ADDRESS
00020 ;ARGS T1=ADDRESS
00030 ;VALUES T1=ADDRESS AFTER OFFSET
00040
00050 CMPOFF: MOVN T2,OFFLEN ;MINUS LENGTH OF OFFSET TABLE
00060 JUMPGE T2,.POPJ ;NO CHANGE IF NO OFFSETS
00070 HRLZS T2
00080 HRR T2,OFFTAB ;MAKE AOBJN PTR TO OFFSET TABLE
00090 CMPOF1: HLRZ T3,(T2) ;BEGINNING OF THIS OFFSET REGION
00100 HRRZ T4,(T2) ;ENDING OF THIS REGION
00110 CAML T1,T3 ;SKIP IF ADDRESS NOT IN THIS REGION
00120 CAMLE T1,T4 ;SKIP IF ADDRESS IS IN THIS REGION
00130 JRST CMPOF2 ;NOT IN THIS REGION
00140 ADD T1,1(T2) ;ADDRESS IS IN THIS REGION, OFFSET
00150 POPJ P, ;EXIT
00160 CMPOF2: AOBJP T2,.POPJ ;LOOK FOR NEXT REGION, EXIT IF NO MORE
00170 AOBJN T2,CMPOF1 ;JUMP IF MORE OFFSETS SPECIFIED
00180 POPJ P,
00190
00200 ;SUBROUTINE TO STORE A VALUE IN A TABLE
00210 ;ARGS T1=VALUE
00220 ; P1=BYTE POINTER TO BE INCREMENTED
00230 ; P2=INDEX IN TABLE VECTOR
00240
00250 STOBYT: PUSH P,T1 ;SAVE VALUE
00260 IBP P1 ;READY BYTE POINTER FOR STORING
00270 TLNE P1,(@) ;IS INDIRECT BIT ON?
00280 HALT . ;YES--BUG
00290 MOVEI T1,(P1) ;ADDR TO STORE INTO
00300 SUB T1,TABVEC(P2) ;-BEGINNING OF TABLE
00310 CAML T1,LENVEC(P2) ;CURRENT LENGTH OF TABLE
00320 PUSHJ P,TABEXP ;EXPAND TABLE
00330 POP P,T1 ;RESTORE VALUE
00340 DPB T1,P1 ;STORE VALUE
00350 POPJ P, ;AND EXIT
00360
00370 ;SUBROUTINE TO EXPAND TABLE TO BE BIG ENOUGH TO STORE VALUE
00380 ;ARGS T1=SIZE NEEDED - 1
00390 ; P2=INDEX IN TABLE VECTOR
00400
00410 TABEXP: SUB T1,LENVEC(P2) ;SUBTRACT CURRENT SIZE=NUM WORDS NEEDED-1
00420 AOJA T1,GETCOR ;EXPAND CORE
00010 ;SUBROUTINE TO CLEAR INDIRECT BIT IN A BYTE POINTER
00020 ; NEEDED BECAUSE HARDWARE INCREMENTS THE ADDRESS IN THE
00030 ; POINTER AND WE WANT TO INCREMENT THE ADDRESS IT IS
00040 ; POINTING TO.
00050 ;ARGS: P1=BYTE POINTER
00060 ;VALUE: P1=BYTE POINTER (FOR SHORT USE)
00070 ;USES NO ACS
00080 ;
00090 MKPNTR: PUSH P,P1 ;SAVE OLD POINTER
00100 MOVEI P1,@P1 ;COMPUTE REAL ADDRESS
00110 HLL P1,(P) ;GET POINTER PART
00120 TLZ P1,37 ;CLEAR INDEX AND INDIRECT
00130 POP P,(P) ;CLEAR STACK
00140 POPJ P, ;RETURN
00010 SUBTTL SUBROUTINES FOR LISTING OUTPUT
00020 ;SUBROUTINE TO OUTPUT A VALUE
00030 ;ARGS T1=VALUE
00040 ; TABLES INCLUDE MODES, WIDTHS, JUSTIFY, ETC.
00050
00060 OUTPT: MOVEM T1,OUTVAL ;SAVE VALUE TO OUTPUT
00070 PUSHJ P,OPNOUT ;MAKE SURE OUTPUT FILE OPEN
00080 SETZM PADCNT ;CLEAR COUNT OF PAD BYTES
00090 TRZ F,R.OVR!R.CNT!R.LFD!R.FFD ;CLEAR COUNT AND OVERFLOW BITS
00100 TLNE F,L.AUTO ;SKIP IF AUTOFORM OFF
00110 TRO F,R.CNT ;NOTE COUNTING
00120 HRLM F,(P) ;SAVE HEADER BITS
00130 OUTPTS: PUSH P,PAGNUM ;SAVE CURRENT PAGE NUMBER
00140 PUSH P,CURCHR ;AND CHARACTER COUNTER
00150 PUSH P,LINNUM ;AND LINE COUNTER, I.E. CURRENT CHAR POSITION
00160 PUSHJ P,SETWJL ;SET UP WIDTH AND JUSTIFY LISTS
00170 TLNE F,L.NXM ;NO SKIP IF NXM
00180 JRST OUTNXM
00190 TLZ DL,DL.NXM ;NO LONGER IN NXM.
00200 MOVE P1,[POINT W.S,LPAD] ;POINTER TO TEMP LIST
00210 MOVEM P1,LPAD.Y ;STORE FOR LATER
00220 MOVE P1,M.Y ;BYTE POINTER FOR MODES LIST
00230 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00240 ILDB T1,P1 ;GET FIRST MODE
00250 CAIN T1,M.END ;SKIP IF NOT END OF LIST
00260 JRST OUTPTX ;END OF OUTPUT
00270 CAIE T1,M.ALL ;SKIP IF ALL MODES REQUESTED
00280 JRST OUTPT1 ;OUTPUT VALUE IN THIS MODE
00290 MOVE P1,[POINT M.S,MODLAL] ;POINTER TO LIST OF ALL MODES
00300 ILDB T1,P1 ;FIRST MODE
00310 OUTPT1: CAIN T1,M.ALL
00320 JRST OUTPTN ;DONT DO "ALL" HERE
00330 ROT T1,-1
00340 MOVE T2,MODADR(T1) ;GET ADDRESS OF ROUTINE FOR THIS MODE
00350 CAIL T1,0 ;SKIP IF ADDR IN RIGHT HALF
00360 MOVSS T2 ;ADDR IN LEFT HALF
00370 TLNE DL,DL.WID ;SKIP IF NO MORE WIDTH SPECS
00380 TLNN F,L.AUTO ;SKIP IF AUTO-FORMAT ON
00390 JRST OTPT1A ;JUMP IF NOT AUTOFORMATTING WIDTHS
00400 ILDB T4,WIDTMP ;GET A WIDTH SPEC.
00410 CAIN T4,W.END ;SKIP IF NOT DONE
00420 JRST OTPT1A ;DONE--NO MORE SPECS
00430 ADD T4,CURCHR ;ADD IN CURRENT POSITION
00440 CAMLE T4,RMARGN ;SKIP IF THIS WILL FIT
00450 TRO F,R.OVR ;PUT WHOLE FIELD ON NEW LINE
00010 OTPT1A: TRNE F,R.CNT ;ARE WE JUST COUNTING?
00020 JRST OUTPT6 ;YES--LIST IS EMPTY
00030 TRZE F,R.OVR ;DO WE NEED A CRLF?
00040 PUSHJ P,NEWLIN ;YES--GO DO IT PRIOR TO BLANKS
00050 MOVEI C," " ;NO--SET UP A BLANK
00060 SOSL T4,PADCNT ;SKIP IF NO COUNTS LEFT
00070 ILDB T4,LPAD.Y ;T4 GETS NUMBER OF BLANKS TO STICK
00080 ; ON THE FRONT OF THE BYTE TO LINE
00090 ; IT UP IN THE FIELD.
00100 JUMPLE T4,OUTPT6 ;JUMP IF NONE REQUIRED
00110 PUSHJ P,LCHR ;LIST A BLANK
00120 SOJG T4,.-1 ;LOOP FOR ALL WE NEED
00010 OUTPT6: PUSHJ P,(T2) ;CALL ROUTINE TO OUTPUT VALUE IN THIS MODE
00020 TLNN DL,DL.WID ;ARE THERE ANY WIDTH SPECS LEFT?
00030 JRST OUTPT4 ;NO--SKIP THE CHECKS
00040 LDB T2,WIDTMP ;GET THE WIDTH
00050 CAIN T2,W.END ;IS THIS THE END?
00060 JRST [TLZ DL,DL.WID ;YES--CLEAR THE BIT
00070 JRST OUTPT4] ;AND PUNT
00080 MOVE T1,SAVCCH ;LOAD T1 WITH THE NUMBER OF CHARS
00090 ; USED FOR DATA WHEN THAT FIELD WAS
00100 ; PRINTED. THIS VALUE IS COMPUTED
00110 ; IN ROUTINE FORMAT.
00120 SUB T2,T1 ; LESS WIDTH IS NUMBER OF BLANKS
00130 ; TO ADD-ON
00140 TLNN DL,DL.JUS ;ANY JUSTIFY KEYS LEFT?
00150 SKIPA T1,[J.LFT] ;NO--ASSUME LEFT
00160 ILDB T1,JUSTMP ;YES--GET THE KEY
00170 CAIN T1,J.END ;IS THIS THE END
00180 JRST [MOVEI T1,J.LFT ;YES--ASSUME LEFT
00190 TLZ DL,DL.JUS;CLEAR THE "WE HAVE A BYTE" BIT
00200 JRST .+1] ;CONTINUE
00210 JUMPLE T2,OUTPT4 ;JUMP IF NEED NO FILLERS
00220 TRNE F,R.CNT ;ONLY COUNTING?
00230 JRST OUTPT5 ;YES--GE STORE FIXUP
00240 CAIN T1,J.RHT ;NO--IS THIS RIGHT JUSTIFIED?
00250 JRST OUTPT4 ;YES--WE DID THAT
00260 CAIN T1,J.CEN ;IS THIS CENTERED
00270 LSH T2,-1 ;YES--CENTER IT
00280 MOVEI C," " ;SET UP A BLANK
00290 PUSHJ P,LCHR ;PRINT IT
00300 SOJG T2,.-1 ;LOOP FOR AS MANY BLANKS AS WE NEED
00310 JRST OUTPT4 ;CONTINUE
00320 OUTPT5: CAIN T1,J.LFT ;LEFT JUSTIFICATION?
00330 SETZ T2, ;YES--NO LEADING BLANKS
00340 CAIN T1,J.CEN ;IF WE NEED AN ODD NUMPER OF PADS
00350 AOS T2 ; CENTERING A FIELD PUT THE FREE
00360 ; SPACE IN FRONT.
00370 CAIN T1,J.CEN ;CENTER IT
00380 LSH T2,-1 ;YES--HALF LEAD ; HALF TRAIL
00390 IDPB T2,LPAD.Y ;STORE AWAY
00400 AOS PADCNT ;COUNT THE BYTE
00010 OUTPT4:
00020 OUTPTN: ILDB T1,P1 ;NEXT MODE
00030 CAIN T1,M.END ;SKIP IF NOT END OF MODES LIST
00040 JRST OUTPTX ;END OF OUTPUT
00050 TLNN DL,DL.WID ;IF WE HAVE A WIDTH LIST DO ADD SPACES
00060 PUSHJ P,LSPC3 ;OUTPUT 3 SPACES BETWEEN MODES
00070 JRST OUTPT1
00080 OUTNXM: TLOE DL,DL.NXM ;FLAG NXM
00090 JRST OUTPTX ;STILL SAME BLOCK OF NXM
00100 MOVEI M,[ASCIZ .<word is not in file>.]
00110 PUSHJ P,LSTR ;OUTPUT NXM INDICATOR
00120 TRO F,R.OVR ;NOTE LINE OVERFLOW
00130 TRNE F,R.CNT ;ARE WE COUNTING?
00140 TLZ DL,DL.NXM ;YES--CAUSE OUTPUT TO HAPPEN AGAIN
00150 ; FOR REAL PRINTING
00160
00170 OUTPTX: TRZN F,R.CNT ;SKIP IF WERE COUNTING, NOT OUTPUTTING
00180 JRST OUTPT3 ;ACTUALLY OUTPUT, ALMOST DONE
00190 OUTPT2: POP P,LINNUM ;RESET BEGINNING CHARACTER POSITION
00200 POP P,CURCHR
00210 POP P,PAGNUM
00220 MOVSI T1,R.LHED ;RESTORE LINE HEADER BIT
00230 TDNE T1,(P)
00240 TRO F,R.LHED
00250 TRZ F,R.OVR ;CLEAR OVERFLOW FLAG
00260 JRST OUTPTS ;AND START OVER ACTUALLY OUTPUTTING
00270
00280 OUTPT3: POP P,T1 ;IGNORE EARLIER CHAR POSITION
00290 POP P,T1
00300 POP P,T1
00310 TLNE F,L.AUTO ;IF AUTOFORMAT OFF
00320 TRNN F,R.OVR ;OR NO OVERFLOW,
00330 POPJ P, ;ALL DONE
00340 PJRST NEWLIN ;IF OVERFLOW AND AUTOFORMAT ON, CRLF
00010 ;SUBROUTINE TO SET UP WIDTH AND JUSTIFY LISTS
00020
00030 SETWJL: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
00040 TLO DL,DL.WID!DL.JUS;TRY TO FILL AND JUSTIFY
00050 MOVE P1,J.Y ;BYTE POINTER TO JUSTIFY LIST
00060 PUSHJ P,MKPNTR ;FIX @ BIT
00070 MOVEM P1,JUSTMP ;SAVE FOR ILDB'ING
00080 MOVE P1,W.Y ;BYTE POINTER TO WIDTH LIST
00090 PUSHJ P,MKPNTR ;FIX @ BIT
00100 MOVEM P1,WIDTMP ;SAVE FOR LATER
00110 POPJ P,
00010 MODALL==.POPJ
00020 MODNUL==.POPJ
00030
00040 MODASC: JSP T4,FORMAT ;CHECK FOR LINE OVERFLOW
00050 MOVE C,OUTVAL ;OUTPUT ASCII CHARACTER
00060 MOVEI M,OUTVAL ;POINT TO OUTPUT VALUE
00070 TDNN C,[<-1>_7] ;IS IT A SINGLE BYTE
00080 JRST MODAS1 ;YES PRINT AS ONE
00090 HRLI M,440700 ;NO--SET UP A POINTER
00100 MOVEI T1,5 ; FOR 5 CHARS
00110 ILDB C,M ;GET A CHAR
00120 PUSHJ P,MODAS1 ;TYPE IT
00130 SOJG T1,.-2 ;LOOP FOR WHOLE WORD
00140 POPJ P, ;RETURN
00150 MODAS1: CAIG C,40 ;CONTROL CHAR?
00160 MOVEI C," " ;YES--PRINT A BLANK INSTAED
00170 PJRST LCHR
00180
00190 MODSIX: JSP T4,FORMAT ;FORMAT THE LINE
00200 MOVE T1,OUTVAL ;OUTPUT SIXBIT CHARACTER
00210 TDNN T1,[<-1>_6] ;ONLY 1 CHAR?
00220 PJRST LCHRS ;YES--LIST 1 CHAR
00230 MOVEI T3,6
00240 MOVE T2,T1 ;NO--LIST AS SIX SIXBIT
00250 PJRST LSIXC ; LETTERS.
00260
00270 ;OUTPUT OUTVAL AS A RADIX 50 SYMBOL
00280
00290 MODRAD: JSP T4,FORMAT ;LINE UP THE OUTPUT
00300 LDB T1,[POINT 4,OUTVAL,3] ;GET PREFIX
00310 PUSHJ P,$LOCT
00320 PUSHJ P,LSPC
00330 MOVE T1,OUTVAL ;GET THE RADIX 50 SYMBOL
00340 $LRAD: TLZ T1,(17B3) ;CLEAR THE CODE BITS
00350 MODR51: IDIVI T1,50 ;WHY THEY CALL IT RADIX 50
00360 HRLM T2,(P) ;SAVE REMAINDER
00370 JUMPE T1,MODR52 ;JUMP IF DONE
00380 PUSHJ P,MODR51 ;ELSE LOOP BACK
00390 MODR52: HLRZ C,(P) ;GET A CHAR
00400 JUMPE C,.POPJ ;PUNT IF NULL
00410 ADDI C,257 ;FIX UP
00420 CAILE C,271
00430 ADDI C,7
00440 CAILE C,332
00450 SUBI C,70
00460 CAIN C,243
00470 MOVEI C,256
00480 TLNN DL,DL.TR5
00490 PJRST LCHR
00500 MOVE T1,C
00510 PJRST .TCHAR##
00010
00020 MODOCT: MOVE T1,OUTVAL ;OUTPUT AS L,R
00030 PJRST LXWD
00040
00050 MODDEC: SKIPA T2,[$LDEC]
00060 MODSOC: MOVEI T2,$LOCT
00070 JSP T4,FORMAT ;DON'T LET THE MINUS BE SPLIT
00080 ; OVER LINE BOUNDARIES.
00090 MOVEI C,"-" ;MINUS SIGN IN CASE NEGATIVE
00100 SKIPGE OUTVAL ;SKIP IF POSITIVE
00110 PUSHJ P,LCHR ;OUTPUT MINUS SIGN
00120 MOVM T1,OUTVAL ;GET POSITIVE VALUE
00130 PJRST (T2) ;AND OUTPUT IN PROPER RADIX
00140
00150 MODFLO: MOVE T1,OUTVAL ;OUTPUT FLOATING POINT NUMBER
00160 PJRST LFLT
00170
00010
00020 MODSYM: TLNN F,L.INST ;INSTRUCTION FORMAT?
00030 PJRST MODOCT ;NO--DUMP AS OCTAL ***TEMP***
00040 JSP T4,FORMAT ;MAKE LOOK NICE
00050 MOVE T1,OUTVAL ;PUT IN WORD
00060 PUSHJ P,OPDEC ;LOOKUP IN TABLE
00070 PUSHJ P,INVOP ;MAKE SOME OPCODE
00080 MOVE T2,N ;COPY OPCODE
00090 MOVEI T3,6 ;INCLUDE SPACES
00100 PUSHJ P,LSIXC ;LIST THE OPCODE
00110 PNTAC: PUSHJ P,LSPC ;LIST A SPACE
00120 MOVEI FM,1 ;HISTORIC CODE
00130 TLO DL,DL.XCT ;EXACT MATCH
00140 LDB T1,[POINT 4,OUTVAL,12] ;GET THE OPCODE
00150 LDB T2,[POINT 3,OUTVAL,2] ;GET FIRST OCTAL DIGIT
00160 CAIN T2,7 ;SKIP IF NOT I/O
00170 LDB T1,[POINT 9,OUTVAL,11] ;GET I/O DEVICE CODE
00180 CAIN T2,7 ;IS IT AN I/O INSTRUCTION
00190 TRZ T1,3 ;YES--CLEAR 2 JUNK BITS
00200 JUMPE T1,ZEROAC ;IS AC=0?
00210 PUSHJ P,$LSYM ;NO--LIST AS SYMBOL
00220 PUSHJ P,LCOMMA ; FOLLOWED BY A COMMA
00230 ZEROAC: MOVSI T1,(@) ;GET AN INDIRECT BIT
00240 MOVEI C,"@" ; AND ITS SYMBOL
00250 TDNE T1,OUTVAL ;IS @ BIT SET
00260 PUSHJ P,LCHR ;YES--PRINT @
00270 HRRZ T1,OUTVAL ;GET Y-ADDRESS
00280 MOVEI FM,2 ;HISTOY TABLE INDEX
00290 TLZ DL,DL.XCT ;ALLOW OFFSET
00300 PUSHJ P,$LSYM ;LIST AS SYMBOL
00310 LDB T1,[POINT 4,OUTVAL,17] ;GET INDEX REG.
00320 JUMPE T1,.POPJ ;JUMP IF ZERO
00330 MOVEI FM,3 ;CODE
00340 TLO DL,DL.XCT ;LIGHT THE EXACT MATCH BIT
00350 MOVEI C,"(" ;ELSE PRINT IN (
00360 PUSHJ P,LCHR ;GO LIST
00370 PUSHJ P,$LSYM ;AND SYMBOL
00380 MOVEI C,")" ;ADD )
00390 PJRST LCHR ;GO ADD IT--THEN POPJ
00010 INVOP: MOVE T1,OUTVAL ;GET THEWORD TO OUTPUT
00020 TDZ T1,[777,,-1] ;CLEAR OUT JUNK
00030 JUMPE T1,ZEROP ;GIVE A Z IF ZERO
00040 CAMN T1,OLDVAL ;SAME AS OLD VALUE?
00050 JRST OLDOP ;YES--REMEMBER THAT BACK
00060 MOVEM T1,OLDVAL ;RECALL LAST ARGUMENT
00070 PUSHJ P,VAL2SY ;SCAN THE SYMBOL TABLE
00080 TLOA T2,(1B0) ;NO MATCH
00090 MOVEM T1,OLDSYM ;SAVE THE SYMBOL
00100 MOVEM T2,SYMOFF ;SAVE THE OFFSET
00110 OLDOP: MOVE T1,SYMOFF ;GET THE OLD OFFSET
00120 JUMPN T1,ZEROP ;JUMP IF NOT EXACT
00130 MOVE T1,OLDSYM ;FETCH SYMBOL
00140 MOVEI N,PNTAC ;HERE WE DO A NONO AND FUDGE THE STACK
00150 MOVEM N,(P) ;SO WE CAN PRINT THE AC AND RETURN TO
00160 PJRST $LRAD ;OP DECODER.
00170 ZEROP: LDB T1,[POINT 9,OUTVAL,8] ;GET OPCODE
00180 MOVSI N,'Z ' ;ASSUME ZERO
00190 JUMPE T1,.POPJ ;JUMP IF GOOD GUESS
00200 LDB T1,[POINT 3,OUTVAL,2]
00210 IORI N,20(T1) ;FILL IN OCTAL DIGIT
00220 LSH N,6 ;GET READY FOR NEXT
00230 LDB T1,[POINT 3,OUTVAL,5]
00240 IORI N,20(T1) ;FILL IN NEXT DIGIT
00250 LSH N,6 ;GET READY FOR LAST
00260 LDB T1,[POINT 3,OUTVAL,8]
00270 IORI N,20(T1) ;PUT IN DIGIT 3
00280 HRLI N,'UUO' ;ADD UUO
00290 POPJ P,0 ;RETURN
00010 ;$LSYM -- PRINT A SYMBOL
00020 ;CALL WITH:
00030 ; T1=VALUE TO PRINT
00040 ;RETURNS NON-SKIP HAVING PRINTED SOMETHING
00050
00060 $LSYM: JUMPE T1,.POPJ ;DO NOT TYPE ZEROS
00070 CAMN T1,OLDVAL(FM) ;SAME ARGUMENT?
00080 JRST LSYM2 ;YES--GIVE SAME ANSWER
00090 MOVEM T1,OLDVAL(FM) ;NO--SAVE FOR NEXT TRY
00100 PUSHJ P,VAL2SY ;CONVERT VALUE
00110 TLOA T2,(1B00) ;IT IS A NUMBER
00120 TLZ T2,(1B00) ;IT IS A SYMBOL
00130 MOVEM T1,OLDSYM(FM) ;STORE ANSWER
00140 JUMPE T2,LSYM1 ;JUMP IF EXACT MATCH
00150 TLNE DL,DL.XCT ;DO WE NEED AN EXACT MATCH
00160 TLO T2,(1B0) ;YES--FORCE NUMERIC MODE
00170 LSYM1: MOVEM T2,SYMOFF(FM) ;SYMBOL ERROR
00180 LSYM2: SKIPGE T2,SYMOFF(FM) ;SKIP IF SYMBOLIC
00190 JRST [MOVE T1,OLDVAL(FM) ;RELOAD THE NUMERIC VALUE
00200 JRST $LNBR] ;LIST AS A NUMBER
00210 MOVE T1,OLDSYM(FM) ;GET LAST ANSWER
00220 PUSHJ P,$LRAD ;NO-PRINT SYMBOL
00230 SKIPN T1,SYMOFF(FM) ;IS THERE AN OFFSET
00240 POPJ P, ;NO--ALL DONE
00250 MOVEI C,"+" ;NO--PRINT A PLUS
00260 PUSHJ P,LCHR ; ..
00270 PJRST $LNBR ;TYPE IN O RADIX
00010 MODSMA: ;IF INSTRUCTION, ELSE ...
00020 POPJ P,
00030
00040
00050 MODNUM: MOVE T1,OUTVAL ;PICK UP VALUE TO BE OUTPUT
00060 PJRST LRDX ; AND LIST IN CURRENT RADIX
00010 ;SUBROUTINE TO START NEW LINE FOR OUTPUT
00020 ;ARGS R.CON1 BIT OF F=1 IF DUMPING CONTENTS
00030 ;SAVES T1
00040
00050 NEWLIN: PUSHJ P,LCRLF ;NEW LINE
00060 PJRST NEWPGX
00070
00080 ;SUBROUTINE TO OUTPUT PAGE EJECT AND REQUEST PAGE HEADER
00090
00100 NEWPAG: PUSHJ P,LEJECT ;OUTPUT PAGE EJECT
00110 TRO F,R.PHED ;REQUEST PAGE HEADER
00120 NEWPGX: TRO F,R.LHED ;REQUEST ADDRESS TO BE TYPED
00130 POPJ P,
00010 SUBTTL OUTPUT SUBROUTINES
00020
00030 ;SUBROUTINE TO OPEN OUTPUT FILE
00040
00050 OPNOUT: TLNE F,L.OOPN ;SKIP IF OUTPUT FILE NOT YET OPEN
00060 POPJ P,
00070 PUSHJ P,.SAVE1 ;SAVE P1
00080 MOVEI P1,O.DEV ;POINT TO OUTPUT SPEC
00090 PUSHJ P,GETSPC ;COPY STICKEY DEFAULTS
00100 SETZM LINNUM ;CLEAR LINE COUNT
00110 SETZ T1, ;ASCII MODE
00120 MOVE T2,O.DEV ;OUTPUT DEVICE
00130 MOVE T4,T2 ;REMEMBER OUTPUT DEVICE FOR DEVCHR
00140 MOVSI T3,B.OC ;BUFFER HEADER
00150 OPEN OC,T1 ;OPEN OUTPUT DEVICE
00160 JRST E.LKO ;CANT OPEN OUTPUT
00170 DEVCHR T4, ;GET CHARACTERISTICS OF OUTPUT DEVICE
00180 TLNE T4,DV.TTY ;SKIP IF NOT A TTY
00190 TLO F,L.OTTY ;NOTE TTY SO WILL CLOSE AFTER EACH DUMP
00200 PUSH P,.JBFF ;SAVE CURRENT .JBFF
00210 MOVEI T1,OBUF
00220 MOVEM T1,.JBFF
00230 OUTBUF OC,1 ;DECLARE 1 OUTPUT BUFFER
00240 POP P,.JBFF ;AND RESET .JBFF
00250 PUSH P,P1
00260 MOVEI P1,FBMTIM ;TIMES TO RETRY IF FILE BEING MODIFIED
00270 PUSH P,DL ;SAVE DL ON STACK
00280 OPNOU1: MOVE T1,O.NAM ;OUTPUT FILE
00290 HLLZ T2,O.EXT ;EXT
00300 SETZ T3, ;STANDARD PROTECTION
00310 HRRI DL,O.DEV ;POINT TO OUTPUT SPEC
00320 PUSHJ P,SETPTH ;SET UP PATH OR PPN IN T4
00330 TRO F,R.LKF ;ASSUME LOOKUP WILL FAIL
00340 TLNE F,L.APP ;SKIP IF SUPERSEDE, NOT IF APPEND
00350 LOOKUP OC,T1 ;APPEND, TRY LOOKUP
00360 JRST OAPP1 ;SUPERSEDE OR LOOKUP FAILED
00370 TRZ F,R.LKF ;LOOKUP OK
00380 OAPP1: PUSHJ P,SETPTH ;SET UP PATH OR PPN IN T4
00390 OSUPER: ENTER OC,T1
00400 JRST OSUPE
00410 HRR DL,(P) ;RESTORE RH(DL)
00420 POP P,P1 ;FIX STACK
00430 POP P,P1 ;RESTORE P1
00440 HLRE T1,T4 ;CURRENT LENGTH OF OUTPUT FILE
00450 JUMPGE T1,OSUP1 ;JUMP IF BLOCKS
00460 MOVNS T1 ;MAKE POSITIVE WORDS
00470 ADDI T1,177
00480 LSH T1,-7 ;CONVERT TO BLOCKS
00490 OSUP1: TRNN F,R.LKF ;SKIP IF SUPERSEDE OR LOOKUP FAILED
00500 USETO OC,1(T1) ;SET TO START WRITING
00510 TLO F,L.OOPN ;NOTE OUTPUT FILE OPEN
00520 POPJ P,
00010 OSUPE: SOJLE P1,E.NSFO ;EXIT IF STILL BUSY
00020 HRRZ T4,T2 ;ERROR CODE
00030 CAIE T4,EC.FBM ;SKIP IF FILE BEING MODIFIED
00040 JRST E.NSFO ;NO, SOME OTHER PROBLEM
00050 MOVEI T4,1
00060 SLEEP T4, ;SLEEP 1 SECOND
00070 JRST OPNOU1 ;AND TRY AGAIN
00080
00090
00100 ;SUBROUTINE TO SET UP T4 AS A PPN IF NO SFD SPECIFIED OR A POINTER
00110 ; TO THE PATH IF NEEDED.
00120 ;USES NO ACS
00130
00140 IFG LN.DRB-1,< ;IF WE HAVE SFD'S
00150 SETPTH: MOVE T4,%DIR(DL) ;SET UP T4 IN CASE
00160 SKIPN %DIR+2(DL) ;NEED A PATH?
00170 POPJ P, ;NO--RETURN
00180 PUSHJ P,.SAVE2 ;SAVE P1-P2
00190 MOVSI P1,-LN.DRB*2 ;NUMBER OF BIWORDS
00200 MOVEI P2,PATH+1 ;WHERE TO PUT PATH
00210 STPTH1: MOVE T4,(P1) ;PICH UP DIRECTORY WORD
00220 PUSH P2,T4 ;STORE IN PATH
00230 AOBJP P2,.+2 ;SKIP OVER THE MASK
00240 AOBJN P2,STPTH1 ;LOOP FOR MORE
00250 MOVEI T4,PATH ;POINT TO PATH
00260 POPJ P, ;RETURN
00270 >
00280
00290 IFLE LN.DRB-1,<
00300 MOVE T4,%DIR(DL) ;GET PPN
00310 POPJ P, ;RETURN
00320 >
00010 ;LFLT -- LIST WORD AS FLOATING POINT NUMBER
00020 ;CALL: MOVE T1,WORD
00030 ; PUSHJ P,LFLT
00040
00050 LFLT: POPJ P,
00060
00070 ;LXWD -- LIST WORD IN XWD FORMAT (N,N)
00080 ;CALL: MOVE T1,WORD
00090 ; PUSHJ P,LXWD
00100 ;USES T1, T2, T3, C
00110
00120 LXWD: JSP T4,FORMAT ;LINE UP THE OUTPUT
00130 MOVE T2,[POINT 3,T1] ;BYTE POINTER TO NUMBER
00140 MOVEI T3,^D12 ;12 DIGITS IN A WORD
00150 LXWD1: ILDB C,T2 ;GET A DIGIT
00160 ADDI C,60 ;MAKE ASCII
00170 PUSHJ P,LCHR ;TYPE THE DIGIT
00180 CAIN T3,7 ;HALF WAY POINT?
00190 PUSHJ P,LCOMMA ;TYPE A COMMA
00200 SOJG T3,LXWD1 ;LOOP FOR WHOLE WORD
00210 POPJ P, ;RETURN
00220
00230
00240
00250 ;LDATE -- OUTPUT DATE IN FORM DD-MMM-YY
00260 ;CALL: MOVE T4,DATE IN SYSTEM FORMAT
00270 ; PUSHJ P,LDATE
00280 ;USES T1, T2, T3, T4, M, C
00290
00300 LDATE: PUSH P,T4+1
00310 IDIVI T4,^D31 ;GET DAY
00320 MOVEI T1,1(T4+1)
00330 PUSHJ P,LDEC2
00340 IDIVI T4,^D12 ;GET MONTH
00350
00360 MOVE T1,[ASCII /-Jan--Feb--Mar--Apr--May--Jun--Jul--Aug--Sep--Oct--Nov--Dec-/](T4+1)
00370 POP P,T4+1
00380 MOVEI T2,0
00390 MOVEI M,T1
00400 PUSHJ P,LSTR
00410 MOVEI T1,^D64(T4) ;GET YEAR
00420 PJRST LDEC2Z ;OUTPUT YEAR AND RETURN
00010 ;LTIME -- OUTPUT TIME IN FORM HH:MM
00020 ;CALL: MOVE T4,TIME IN MINUTES
00030 ; PUSHJ P,LTIME
00040 ;USES T1, T2, T3, T4, T5, C
00050
00060 LTIME: PUSH P,T4+1 ;SAVE T5 (WHICH IS P1)
00070 IDIVI T4,^D60 ;GET HOURS
00080 MOVE T1,T4
00090 PUSHJ P,LDEC2 ;LIST HOURS
00100 MOVEI C,":"
00110 PUSHJ P,LCHR
00120 MOVE T1,T4 ;LIST MINUTES
00130 POP P,T4+1 ;RESTORE T5
00140 ;FALL INTO LDEC2Z
00150
00160 ;LDEC2Z -- LIST DECIMAL AT LEAST 2 DIGITS WITH LEADING ZERO
00170 ;CALL: MOVEI T1,NUMBER
00180 ; PUSHJ P,LDEC2Z
00190 ;USES T1, T2, T3, C
00200
00210 LDEC2Z: MOVEI C,"0" ;SETUP TO PRINT 0 IN CASE NEEDED
00220 CAIGE T1,^D10 ;TEST TO SEE IF NEEDED
00230 PUSHJ P,LCHR ;YES--SEND IT
00240 PJRST LDEC ;GO FINISH WORK
00250
00260
00270
00280 ;LSTDC2 -- LIST MESSAGE, DECIMAL NUMBER, AND TWO SPACES
00290 ;CALL: MOVEI M,MESSAGE
00300 ; MOVE T1,NUMBER
00310 ; PUSHJ P,LSTDC2
00320 ;USES T1, T2, T3, M, C
00330
00340 LSTDC2: PUSHJ P,LSTR ;LIST THE MESSAGE
00350 PUSHJ P,LDEC ;LIST THE DECIMAL NUMBER
00360 PJRST LSPC2 ;LIST THE TWO SPACES AND RETURN
00010 ;LDEC4 -- LIST DECIMAL AT LEAST FOUR DIGITS
00020 ;LDEC3 -- LIST DECIMAL AT LEAST THREE DIGITS
00030 ;LDEC2 -- LIST DECIMAL AT LEAST TWO DIGITS
00040 ;CALL: MOVEI T1,NUMBER
00050 ; PUSHJ P,LDEC2
00060 ;USES T1, T2, T3, C
00070
00080 LDEC4: CAIGE T1,^D1000 ;SEE IF NEEDED
00090 PUSHJ P,LSPC
00100 LDEC3: CAIGE T1,^D100
00110 PUSHJ P,LSPC
00120 LDEC2: CAIGE T1,^D10
00130 PUSHJ P,LSPC ;YES
00140 ;FALL INTO LDEC
00150
00160 ;LDEC -- LIST DECIMAL NUMBER
00170 ;LOCT -- LIST OCTAL NUMBER
00180 ;LRDX -- LIST VIA PRESET RADIX
00190 ;CALL: MOVEI T1,NUMBER
00200 ; (MOVEI T3,RADIX LRDX ONLY)
00210 ; PUSHJ P,LDEC/LOCT/LRDX
00220 ;USES T1, T2, T3, C
00230
00240 LDEC: MOVEI T3,^D10 ;INITIALIZE FOR DECIMAL RADIX
00250 JRST LRDX1
00260 LRDX: SKIPA T3,ORADIX ;INITIALIZE FOR CURRENT OUTPUT RADIX
00270 LOCT: MOVEI T3,10 ;INITIALIZE FOR OCTAL RADIX
00280 LRDX1: JSP T4,FORMAT ;TAKE CARE OF FORMATING
00290 JRST $LRDX ;OUTPUT
00300
00310 $LNBR: MOVE T3,ORADIX ;PICK UP OUTPUT RADIX
00320 JRST $LRDX ;PRINT
00330 $LDEC: SKIPA T3,[^D10] ;INITIALIZE FOR DECIMAL
00340 $LOCT: MOVEI T3,10 ;INITIALIZE FOR OCTAL RADIX
00350 $LRDX: MOVEI C,"-" ;IN CASE -VE
00360 SKIPGE T1 ;SKIP IF POSITIVE
00370 PUSHJ P,LCHR ;ELSE PRINT THE MINUS
00380 CAMN T1,[1B0] ;JUST THE SIGN BIT?
00390 AOS T1 ;YES--MAKE LARGER
00400 MOVM T1,T1 ;MAKE T1 POSITIVE
00410 $LRDX1: IDIV T1,T3 ;DIVIDE BY RADIX
00420 HRLM T2,(P) ;SAVE REMAINDER
00430 SKIPE T1 ;SEE IF ANYTHING LEFT
00440 PUSHJ P,$LRDX1 ;YES--LOOP BACK WITH PD LIST
00450 HLRZ C,(P) ;GET BACK A DIGIT
00460 ADDI C,"0" ;CONVERT TO ASCII
00470 PJRST LCHR ;GO LIST IT
00010 ;LCRLF3 - LIST END OF LINE AND 2 BLANKS
00020 ;LCRLF2 - LIST END OF LINE AND 1 BLANK LINE
00030
00040 LCRLF3: PUSH P,LMARGN ;SAVE LEFT MARGIN FOR NOW
00050 SETZM LMARGN ;CLEAR SO WONT WRITE SPACES
00060 PUSHJ P,LCRLF ;NEW LINE
00070 JRST LCRL2A ;AND ANOTHER NEW LINE
00080 LCRLF2: PUSH P,LMARGN ;SAVE LEFT MARGIN FOR NOW
00090 SETZM LMARGN ;;CLEAR SO WONT WRITE SPACES
00100 LCRL2A: PUSHJ P,LCRLF ;NEW LINE
00110 POP P,LMARGN ;RESTORE LEFT MARGIN
00120
00130 ;LCRLF - LIST END OF LINE
00140 ;CALL: PUSHJ P,LCRLF
00150 ;USES M, C
00160
00170 LCRLF: TRZ F,R.LTAB ;CLEAR TAB MEMORY
00180 MOVEI M,[ASCIZ /
00190 /]
00200 JRST $LSTR
00210
00220 ;LSTR - LIST ASCII STRING
00230 ;CALL: MOVEI M,STRING (END WITH 0 BYTE)
00240 ; PUSHJ P,LSTR
00250 ;USES M, C
00260
00270 LSTR: JSP T4,FORMAT
00280 $LSTR: TLOA M,440700 ;CONVERT TO BYTE POINTER
00290 LSTR1: PUSHJ P,LCHR ;OUTPUT CHARACTER
00300 ILDB C,M ;GET NEXT CHARACTER
00310 JUMPN C,LSTR1 ;LOOP UNLESS NULL
00320 POPJ P, ;RETURN
00330
00340
00350 ;LSIXT -- LIST SIXBIT WORD FOLLOWED BY TAB
00360 ;CALL: MOVE T2,WORD
00370 ; PUSHJ P,LSIXT
00380 ;USES T1, T2, C
00390
00400 LSIXT: PUSHJ P,LSIXN ;OUTPUT WORD
00410 PJRST LTAB ;GO OUTPUT TAB AND RETURN
00010 ;LSIX -- LIST SIXBIT WORD (AT LEAST ONE SPACE)
00020 ;LSIXN -- SAME EXCEPT 0 GIVES NO SPACES
00030 ;CALL: MOVE T2,WORD
00040 ; PUSHJ P,LSIX/LSIXN
00050 ;USES T1, T2, C
00060
00070 LSIX: MOVEI T1,0 ;CLEAR NEXT CHARACTER
00080 LSHC T1,6 ;FETCH NEXT CHAR
00090 PUSHJ P,LCHRS ;LIST IT IN SIXBIT
00100
00110 LSIXN: JUMPN T2,LSIX ;LOOP UNTIL ONLY BLANKS LEFT
00120 POPJ P, ;RETURN
00130
00140
00150 ;LSIXC -- LIST SIXBIT WORD FIXED NUMBER OF CHARACTERS
00160 ;CALL: MOVE T2,WORD
00170 ; MOVEI T3,NUM CHARS TO PRINT
00180 ; PUSHJ P,LSIXC
00190 ;USES T1, T2, T3, C
00200
00210 LSIXC: MOVEI T1,0 ;CLEAR NEXT CHAR
00220 LSHC T1,6 ;GET NEXT CHAR
00230 PUSHJ P,LCHRS ;LIST IT IN SIXBIT
00240 SOJG T3,LSIXC ;LOOP UNTIL DONE
00250 POPJ P, ;RETURN
00260
00270
00280 ;LSPC3 -- LIST THREE SPACES
00290 ;LSPC2 -- LIST TWO SPACES
00300 ;CALL: PUSHJ P,LSPC2
00310 ;USES C
00320
00330 LSPC3: PUSHJ P,LSPC ;DO ONE
00340 LSPC2: PUSHJ P,LSPC ;DO ONE
00350 PJRST LSPC ;DO ANOTHER AND RETURN
00010 ;SUBROUTINE TO TAKE CARE OF OVERFLOWING LINE OR PAGE
00020 ;SAVES P1, P2
00030
00040 FORMAT: TROE F,R.NORE ;SKIP IF NOT ALREADY IN THIS SUBROUTINE
00050 JRST (T4) ;DONT RECURSE, JUST PASS THROUGH
00060 MOVEM M,SAVEM ;SAVE AC'S
00070 MOVE M,[XWD T1,SAVET1]
00080 MOVEM F,SAVEF ;SAVE F
00090 BLT M,SAVEP2
00100 TRZ F,R.SCNT ;ASSUME COUNT BIT OFF
00110 TROE F,R.CNT ;SAVE OLD COUNT BIT, SET IT FOR NOW
00120 TRO F,R.SCNT ;COUNT BIT WAS ON
00130 MOVE P2,SAVEP2
00140 PUSH P,PAGNUM ;SAVE CURRENT CHARACTER POSITION
00150 PUSH P,LINNUM
00160 PUSH P,CURCHR
00170 PUSHJ P,FORMT2 ;MAKE WIDTH AND JUSTIFY WORK
00180 MOVN M,CURCHR ;STORE THE CURRENT CHAR. POSITION
00190 MOVEM M,SAVCCH ; NEGATED, IN SAVCCH
00200 MOVE M,SAVEM ;RESTORE M
00210 PUSHJ P,(T4) ;CALL ROUTINE TO COUNT CHARS TO BE OUTPUT
00220 MOVEI T2,NEWLIN
00230 MOVE T1,CURCHR ;NEW CHARACTER POSITION
00240 ADDM T1,SAVCCH ;SAVCCH := WIDTH OF PRINTED FIELD
00250 CAMLE T1,RMARGN ;SKIP IF NOT YET PAST RIGHT MARGIN
00260 PUSHJ P,FORMFX ;OUTPUT CRLF FIRST
00270 MOVEI T2,NEWPAG
00280 MOVE T1,LINNUM ;NEW LINE NUMBER
00290 CAMLE T1,LINPAG ;SKIP IF NOT YET PAST END OF PAGE
00300 PUSHJ P,FORMFX ;OUTPUT PAGE EJECT FIRST
00310 POP P,CURCHR
00320 POP P,LINNUM
00330 POP P,PAGNUM
00340 MOVE T1,SAVEF
00350 ANDI T1,R.LHED!R.PHED ;REMEMBER HEADER BITS
00360 IOR F,T1
00370 TRZE F,R.SCNT ;SKIP IF WAS SUPPOSED TO OUTPUT
00380 JRST FORMT1 ;NO, JUST COUNT CHARS, LEAVE COUNT BIT ON
00390 TRZ F,R.CNT ;YES, TURN OFF COUNT BIT
00400 PUSHJ P,FORMF1 ;OUTPUT IT
00410 FORMT1: MOVE P1,SAVEP1 ;RESTORE P1-P2
00420 MOVE P2,SAVEP2
00430 TRZ F,R.NORE
00440 POPJ P, ;EXIT
00450
00460 FORMT2: TRNN F,R.LHED!R.PHED ;DO WE WANT TO PRINT HEADERS
00470 POPJ P, ;NO--RETURN
00480 MOVEI C,200 ;FLAG TO GENERATE HEADER
00490 PJRST LCHR ;GO DO IT
00010 FORMFX: TRNN F,R.SCNT ;SKIP IF ONLY COUNTING
00020 TRZ F,R.CNT ;NO, CLEAR COUNT BIT
00030 POP P,T1 ;SAVE RETURN FROM SUBROUTINE
00040 POP P,CURCHR ;RESTORE ORIGINAL CHARACTER POSITION
00050 POP P,LINNUM
00060 POP P,PAGNUM
00070 PUSH P,T1 ;RESTORE RETURN FROM SUBROUTINE
00080 TRZ F,R.LHED!R.PHED ;DONT WANT LINE OR PAGE HEADER HERE
00090 PUSHJ P,(T2) ;CALL APPROPRIATE ROUTINE
00100 MOVE T1,F ;REMEMBER HEADER BITS
00110 ANDI T1,R.PHED!R.LHED
00120 IORM T1,SAVEF ;SAVE FOR ROUTINE EXIT
00130 TRO F,R.CNT
00010 POP P,T1 ;SAVE RETURN FROM SUBROUTINE
00020 PUSH P,PAGNUM
00030 PUSH P,LINNUM
00040 PUSH P,CURCHR
00050 PUSH P,T1 ;RESTORE RETURN FROM SUBROUTINE
00060 FORMF1: MOVE M,[XWD SAVET1,T1]
00070 BLT M,P2 ;RESTORE ORIGINAL AC'S
00080 MOVE M,SAVEM
00090 PJRST (T4) ;CALL OUTPUT ROUTINE
00100
00110 LEJECT: MOVEI C,C.FF
00120 PJRST LCHR
00010 ;LCRT -- LIST A CARRAGE RETURN
00020 ;LTAB -- LIST TAB
00030 ;LSPC -- LIST SPACE
00040 ;LCHR -- LIST CHARACTER
00050 ;LCHRS-- LIST SIXBIT CHARACTER
00060 ;CALL: (MOVEI C,CHARACTER IF LCHR)
00070 ; (MOVEI T1,CHARACTER IF LCHRS)
00080 ; PUSHJ P,LTAB/LSPC/LCHR
00090 ;USES C EXCEPT LCHR USES NO AC'S
00100
00110 LCRT: MOVEI C,.CHCRT
00120 PJRST LCHR1
00130 LCOMMA: SKIPA C,[","] ;LOAD A COMMA
00140 LCHRS: MOVEI C," "-' '(T1) ;CONVERT TO ASCII AND MOVE TO C
00150 LCHR: JUMPE C,.POPJ ;DO NOT PRINT NULLS
00160 CAIE C," " ;SEE IF A TAB
00170 JRST LCHR1 ;NO--GO SEND IT
00180
00190 LTAB: TRON F,R.LTAB ;SET/TEST TAB
00200 POPJ P, ;RETURN IF NOT TWO IN A ROW
00210
00220 LTAB1: SKIPA C,[" "] ;GET THE TAB
00230 LSPC: MOVEI C," " ;GET THE SPACE
00010 LCHR1: TRZE F,R.LTAB ;CLEAR TAB MEMORY
00020 JRST LCHR3 ;IF SET, GO ISSUE ONE
00030 TRZE F,R.PHED ;SKIP IF DONT WANT PAGE HEADER
00040 PUSHJ P,PHEAD ;OUTPUT PAGE HEADER
00050 TRZE F,R.MARS ;SKIP IF DONT NEED LEFT MARGIN SPACES
00060 PUSHJ P,MARSPC ;OUTPUT SPACES FOR LEFT MARGIN
00070 TRZE F,R.LHED ;SKIP IF DONT WANT ADDR TYPED
00080 PUSHJ P,LHEAD ;OUTPUT ADDR AS LINE HEADER
00090 TRZE F,R.LTAB ;SEE IF LHEAD GOT US INTO A BAD STATE
00100 JRST LCHR3 ; AND IF IT DID CLEAN UP.
00110 CAIN C,200 ;SPECIAL FLAG?
00120 POPJ P, ;YES--QUIT NOW
00130 JUMPE C,LCHR6 ;JUMP IF NULL
00140 CAIL C,40 ;SKIP IF NON-GRAPHIC
00150 JRST LCHR5 ;OK
00160 PUSH P,T1
00170 MOVEI T1,7 ;PREPARE FOR POSSIBLE TAB
00180 CAIN T1,.CHTAB ;IS IT A TAB
00190 IORM T1,CURCHR ;YES--FORCE TO A TAB STOP
00200 MOVEI T1,1
00210 LSH T1,-1(C) ;POSITON BIT FOR CHAR
00220 TDNE T1,FORMCH ;SKIP IF NOT LEGAL FORM CHAR
00230 JRST LCHR4 ;OK, OUTPUT CHAR AS IS
00240 PUSH P,C ;SAVE CHAR
00250 MOVEI C,"^" ;NO, FLAG AS CONTROL LETTER
00260 PUSHJ P,LCHR
00270 POP P,C
00280 ADDI C,100 ;AND MAKE GRAPHIC
00290 LCHR4: POP P,T1
00300 LCHR5: AOS CURCHR ;COUNT CHARS ON THIS LINE
00310 LCHR6: TRNE F,R.CNT ;SKIP IF ACTUALLY OUTPUTTING
00320 JRST LNOWRT ;NO, ONLY COUNTING, DONT OUTPUT
00330 SOSG B.OC+2 ;SEE IF ROOM IN THE BUFFER
00340 JRST LCHRW ;NO--GO WRITE THIS BUFFER
00350 LCHR2: TLNE F,L.OTTY ;IS OUTPUT TO TTY: ?
00360 TLZ F,L.TDMP ;YES--MAKE TDUMP=DUMP
00370 TLNE F,L.TDMP ;DOES HE WANT IT ON HIS TTY ALSO?
00380 OUTCHR C ;YES--DO THAT TOO
00390 IDPB C,B.OC+1 ;YES--SEND CHARACTER
00400 LNOWRT: CAIL C,C.LF ;SKIP IF NOT END OF LINE CHAR
00410 CAILE C,C.CR ;SKIP IF END OF LINE CHAR
00420 POPJ P,
00430 TRO F,R.MARS ;NOTE NEED FOR SPACES FOR LEFT MARGIN
00440 SETZM CURCHR ;RESTART CHAR COUNTER
00450 CAIN C,C.LF ;SKIP IF NOT LINE FEED
00460 AOS LINNUM ;YES, COUNT 1 LINE
00010 CAIN C,C.FF ;SKIP IF NOT PAGE EJECT
00020 SETZM LINNUM
00030 MOVEI T1, ;INCREMENT FOR VT
00040 CAIN C,C.VT ;SKIP IF VERTICAL TAB
00050 ADDM T1,LINNUM
00060 POPJ P, ;RETURN
00070
00080 LCHR3: PUSH P,C ;SAVE REQUESTED CHARACTER
00090 PUSHJ P,LTAB1 ;SEND A TAB
00100 POP P,C ;RESTORE CHARACTER
00110 JRST LCHR1 ;PROCEED
00010 PHEAD: SKIPE LINNUM ;TOP OF FORM?
00020 POPJ P, ;NO--SHOULD NOT GET HERE
00030 PUSHJ P,SAVHED ;SAVE AC'S FOR HEADER SUBROUTINES
00040 TRZE F,R.LHED ;SKIP IF LINE HEADER NOT NEEDED
00050 TRO F,R.RLH ;REMEMBER THAT BIT
00060 PUSHJ P,LCRT ;LIST THE <CR>
00070 SKIPE T1,PAGNUM ;SKIP IF NOT NUMBERING PAGES
00080 JRST NEWPG1 ;NUMBERING, T1=CURRENT PAGE NUMBER
00090 TLNN F,L.TITL ;SKIP IF TITLE SPECIFIED
00100 JRST NEWPG6 ;NO TITLE LINE
00110 NEWPG1: MOVEI C,1
00120 IDIVI T1,^D10
00130 JUMPE T1,.+2
00140 AOJA C,.-2 ;COUNT CHARS FOR PAGE NUMBER
00150 ADDI C,7 ;PLUS <SPACE>PAGE<SPACE><SPACE>
00160 MOVE T1,RMARGN ;RIGHT MARGIN
00170 SUB T1,LMARGN ;MINUS LEFT MARGIN=CHARS LEFT FOR TITLE+PAGE NUM
00180 SUB T1,C ;MINUS CHARS FOR PAGE NUM=CHARS FOR TITLE
00190 JUMPLE T1,NEWPG5 ;JUMP IF NO ROOM FOR TITLE
00200 SKIPN TITLEN ;SKIP IF NON-NULL TITLE
00210 JRST NEWPG4 ;NO TITLE
00220 MOVE P1,TIT.Y ;BYTE POINTER FOR TITLE
00230 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00240 NEWPG3: ILDB C,P1 ;NEXT CHAR OF TITLE
00250 CAIN C,TIT.EN ;SKIP IF NOT END OF TITLE
00260 JRST NEWPG4
00270 PUSHJ P,LCHR ;OUTPUT THE CHAR
00280 SOJG T1,NEWPG3 ;LOOP FOR NUMBER OF CHARS ALLOWED FOR TITLE
00290 JRST NEWPG5 ;NO MORE ROOM
00010 NEWPG4: SKIPN PAGNUM ;NO NEED FOR SPACES IF NOT NUMBERING PAGES
00020 JRST NEWPG6
00030 PUSHJ P,LSPC ;FINISHED TITLE, FILL OUT WITH SPACES
00040 SOJG T1,.-1
00010 NEWPG5: SKIPN PAGNUM ;SKIP IF NUMBERING PAGES
00020 JRST NEWPG6 ;END OF TITLE LINE
00030 MOVEI M,[ASCIZ . PAGE .]
00040 PUSHJ P,$LSTR
00050 MOVE T1,PAGNUM ;CURRENT PAGE NUMBER
00060 PUSHJ P,$LDEC ;OUTPUT PAGE NUMBER
00070 AOS PAGNUM ;AND BUMP COUNT
00080 NEWPG6: PUSHJ P,LCRLF ;END OF TITLE LINE
00090 TLNN F,L.SUBT ;SKIP IF WANT SUBTITLE
00100 JRST NEWPGE ;NO, ALL DONE
00110 MOVE T1,RMARGN ;RIGHT MARGIN
00120 SUB T1,LMARGN ;MINUS LEFT MARGINCHARS FOR SUBTITLE
00130 JUMPLE T1,NEWPGE ;NO ROOM
00140 MOVE P1,SUBT.Y ;BYTE POINTER FOR SUBTITLE
00150 PUSHJ P,MKPNTR ;CLEAR INDIRECT BIT IN POINTER
00160 NEWPG7: ILDB C,P1 ;GET NEXT CHAR OF SUBTITLE
00170 CAIN C,SUBT.E ;SKIP IF NOT END OF SUBTITLE
00180 JRST NEWPGE
00190 PUSHJ P,LCHR ;OUTPUT THE CHAR
00200 SOJG T1,NEWPG7
00210 NEWPGE: SKIPE LINNUM ;DO NOT NEED BLANK LINES
00220 ; IF NO TITLE GIVEN.
00230 PUSHJ P,LCRLF3 ;2 BLANK LINES AFTER SUBTITLE
00240 TRZE F,R.RLH ;SKIP IF LINE HEADER WAS NOT REQUESTED
00250 TRO F,R.LHED ;TURN REQUEST BACK ON
00260 POPJ P,
00010 LHEAD: TLNE F,L.ADDR ;SKIP IF ADDR IS OFF
00020 TRNN F,R.CON1 ;SKIP IF DUMPING CONTENTS
00030 POPJ P, ;NO HEADER
00040 CAIGE C,40 ;REAL CHARACTER?
00050 JRST [TRO F,R.LHED ;NO--HOLD OFF
00060 POPJ P,0] ; UNTILL SOMETHING IS SEEN.
00070 PUSHJ P,SAVHED ;SAVE AC'S FOR HEADER SUBROUTINES
00080 MOVE T1,SAVADR ;ADDRESS
00090 PUSHJ P,$LOCT ;OUTPUT ADDRESS
00100 MOVEI M,[ASCIZ ./ .]
00110 PJRST $LSTR
00120
00130 MARSPC: PUSHJ P,SAVHED ;SAVE AC'S FOR HEADER SUBROUTINES
00140 SKIPN T1,LMARGN ;SKIP IF NEED SPACES FOR LEFT MARGIN
00150 POPJ P, ;NO SPACES NEEDED
00160 PUSHJ P,LSPC ;OUTPUT SPACES OVER TO LEFT MARGIN
00170 SOJG T1,.-1
00180 POPJ P,
00190
00200 ;SUBROUTINE TO SAVE AC'S FOR HEADER SUBROUTINES
00210
00220 SAVHED: EXCH T1,(P) ;SAVE T1 AND RETRIEVE RETURN
00230 PUSH P,T2
00240 PUSH P,T3
00250 PUSH P,C
00260 PUSH P,M
00270 PUSH P,P1
00280 PUSHJ P,(T1) ;CALL CALLING SUBROUTINE
00290 POP P,P1
00300 POP P,M
00310 POP P,C
00320 POP P,T3
00330 POP P,T2
00340 PJRST T1POPJ
00010 ;HERE TO WRITE ONE BUFFER
00020
00030 LCHRW: OUT OC, ;OUTPUT BUFFER
00040 JRST LCHR2 ;OK--GO DO CHARACTER NOW
00050 PUSH P,T1 ;ERROR--SAVE SOME ACS
00060 PUSH P,T2 ; ..
00070 PUSH P,T3 ; ..
00080 GETSTS OC,T1 ;GET ERROR STATUS
00090 MOVE T2,T1 ;PREPARE TO CLEAR
00100 ANDI T2,37777 ; BY PRESERVING JUST
00110 SETSTS OC,(T2) ; THE CONTROL BITS
00120 OUTSTR [ASCIZ /
00130 % Listing device output error, status /]
00140 MOVE T3,[POINT 3,T1,17] ;SETUP FOR OCTAL TYPEOUT
00150 LCHRWE: ILDB T2,T3 ;GET DIGIT
00160 ADDI T2,"0" ;CONVERT TO ASCII
00170 OUTCHR T2 ;TYPE IT
00180 TLNE T3,(77B5) ;SEE IF DONE YET
00190 JRST LCHRWE ;NO--LOOP
00200 OUTSTR [ASCIZ /
00210 /] ;NOTE--ALL THIS DONE HERE IN CASE
00220 ; WRONG SEGMENT IN CORE
00230
00240 POP P,T3 ;RESTORE ACS
00250 POP P,T2 ; ..
00260 POP P,T1 ; ..
00270 JRST LCHR2 ;AND WRITE NEXT CHARACTER
00010 SUBTTL SYMBOL TABLE LOGIC -- SYMBOL COMMANDS
00020
00030 ;XTRACT -- PULL SYMBOL TABLE FROM .SAV, .SHR, .DAE, .HGH, AND SO ON
00040
00050 XPROC: PUSHJ P,GIVSYM ;GIVE BACK PREMUTATION VECTOR
00060 TLZ F,L.IOPN ;CAUSE INPUT FILE TO LOOK CLOSED
00070 HRRI DL,S.ZER ;POINT TO SYFILE
00080 MOVEI T1,.JBSYM ;LOOK FOR SYMBOL TABLE POINTER
00090 TLO DL,DL.SYM ;NOTE WE ARE READING SYMBOL TABLE
00100 PUSHJ P,FNDADR ;GO FIND THE POINTER
00110 TLNN F,L.NXM ;WAS THERE A POINTER?
00120 SKIPL T1 ;WITH SOMETHING IN IT
00130 JRST TRYHSM ;NO--GO LOOK IN .JBHSM
00140 MOVEM T1,SYMPTR ;SAVE SYMBOL TABLE POINTER
00150 PUSHJ P,GETST ;GO READ IN THE SYMBOL TABLE
00160 TRYHSM: MOVEI T1,.JBHSM+1B18 ;POINT TO HISEG POINTER
00170 PUSHJ P,FNDADR ;GO GRAB IT
00180 TLNN F,L.NXM ;DOES IT EXIST?
00190 SKIPL T1 ;AND IS IT VALID?
00200 JRST FINXPR ;NO--GO AWAY
00210 CAMN T1,SYMPTR ;IS IT THE SAME AS .JBSYM
00220 JRST FINXPR ;YES--GO AWAY
00230 MOVEM T1,SYMPTR ;SAVE FOR LATER
00240 PUSHJ P,GETST ;READ HISEG POINTER
00250 FINXPR: TLZ F,L.IOPN ;INPUT NO LONGER OPEN
00260 TLZ DL,DL.SYM ;WE ARE NO LONGER READING SYMBOL TABLE
00270 TLO DL,DL.FBR ;SET DL.FBR SO FIXSYM WILL GENERATE
00280 ; POINTERS.
00290 PUSHJ P,FIXSYM ;***TEMP*** FIX UP POINTERS NOW
00300 HRRI DL,I.ZER ;POINT BACK TO INPUT
00310 MOVSI T1,1 ;CAUSE NEW WIDOW TO BE READ
00320 MOVEM T1,WINADR ; ..
00330 PUSHJ P,.TCRLF## ;TYPE A CRLF
00340 MOVE T1,SYMLEN ;GET LENGTH OF SYMBOL TABLE
00350 LSH T1,-1 ;DIVIDE BY TWO
00360 PUSHJ P,.TDECW## ;TYPE THE DECIMAL WORD
00370 MOVEI T1,[ASCIZ / symbols eXTRACTed
00380 /]
00390 PJRST .TSTRG## ;LIST THE STRING AND RETURN
00010 SUBTTL SYMBOL TABLE LOGIC -- SUBROUTINES
00020
00030 ;READ SYMBOL TABLE FROM FILE
00040
00050 GETST: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
00060 HLRE T1,SYMPTR ;GET POSITIVE WC
00070 MOVM T1,T1 ; IN T1
00080 ADD T1,SYMLEN ;INCLUDE CURRENT SIZE
00090 MOVEI P2,SYMNDX ;GET INDEX
00100 PUSHJ P,GETCOR ;GET THE CORE FROM THE MONITOR
00110 MOVEI P1,@SYMTAB ;POINT TO SYMTAB
00120 MOVE P2,SYMPTR ;POINT TO IT IN IMAGE FILE
00130 SOS P1 ;THE PUSH WILL ADD THEN STORE
00140 GETST1: HRRZ T1,P2 ;GET ADDRESS OF WORD
00150 PUSHJ P,FNDADR ;GET THE WORD
00160 TLNE F,L.NXM ;WAS IT THERE?
00170 JRST GETST2 ;NO--NO MORE CORE
00180 PUSH P1,T1 ;STORE THE WORD
00190 AOBJN P2,GETST1 ;LOOP FOR WHOLE TABLE
00200 POPJ P, ;RETURN
00210
00220 ;HERE IF NOT ALL OF S.T. IN CORE IMAGE FILE
00230
00240 GETST2: HLRZ P1,P1 ;GET THE NUMBER OF PUSHES
00250 MOVE T1,SYMLEN ;GET THE LENGTH OF THE SYMBOL TABLE
00260 SUB T1,P1 ;GET THE NUMBER OF WORDS TO GIVE BACK
00270 MOVEI P2,SYMNDX ;POINT TO S.T.
00280 PJRST GIVCOR ;RETURN EXCESS
00010 ;EVALUATE A SYMBOL -- CALLED FROM EXPRESSION EVALUATER
00020
00030 EXPSYM: PUSHJ P,REDSYM ;READ A SYMBOL
00040 POPJ P, ;RETURN -- IT WAS A NUMBER
00050 JUMPE T1,.POPJ ;ZERO IS NOT A SYMBOL
00060 SETZ T3, ;ASSUME JUST A SYMBOL
00070 CAIE C,":" ;WAS IT A ST NAME
00080 JRST EXPSY1 ;NO--JUST LOOKUP
00090 PUSH P,T1 ;YES--SAVE NAME
00100 PUSHJ P,REDSYM ;GO READ A RADIX 50 SYMBOL
00110 JRST E.SYMF ;CANT BE A NUMBER
00120 MOVN T2,SYNLEN ;T2 := -(LENGTH OF ST NAMES)
00130 MOVSI T2,(T2) ;SWAP SO IT IS XWD -LENGTH,0
00140 HRRI T2,@SYNTAB ;GET POINTER TO S.T. NAMES
00150 EXCH T1,(P) ;GET BACK S.T. NAME
00160 CAME T1,(T2) ;SCAN TABLE FOR MATCH
00170 AOBJN T2,.-1 ; ..
00180 JUMPGE T2,E.STNU ;IF NO MATCH S.T. NAME IS UNDEFINED
00190 SUBI T2,@SYNTAB ;GET BACK INDEX
00200 ADDI T2,@SYPTAB ;POINT TO VALUE
00210 MOVE T3,(T2) ;PICK UP S.T. POINTER
00220 POP P,T1 ;RESTORE T1 (SYMBOL TO LOOK FOR)
00230 EXPSY1: PUSHJ P,SY2VAL ;CONVERT SYMBOL NAME TO VALUE
00240 SKIPA T2,[-L.MSYM,,0] ;UNDEFINED SEE IF BUILT-IN
00250 POPJ P, ;RETURN VALUE IN T1
00260 CAME T1,MSYMTB(T2) ;IS THIS IT?
00270 AOBJN T2,.-1 ;NO--LOOP OVER ALL
00280 JUMPG T2,E.SYMU ;UNDEFINED
00290 MOVE T1,@MSYMAD(T2) ;PICK UP VALUE
00300 POPJ P, ;RETURN
00010 ;SUBROUTINE TO CONVERT SYMBOL TO VALUE
00020
00030 SY2VAL: SETZM SYMPTR ;CLEAR POINTER
00040 TLZ DL,DL.PNF!DL.MDL;CLEAR STATUS BITS
00050 SKIPN T2,SYMLEN ;GET SIZE OF SYMBOL TABLE
00060 POPJ P, ;EMPTY
00070 LSH T2,-1 ;DIVIDE BY 2
00080 MOVN T4,SYMLEN ;PICK UP -VE LENGTH OF S.T.
00090 SKIPN T3 ;SKIP IF WE HAVE POINTER
00100 HRL T3,T4 ;WE DON'T -- COPY THIS POINTER
00110 ADDI T3,@SYMTAB ;POINT TO REAL S.T.
00120 SY2VL3: MOVE T4,(T3) ;GET SYMBOL
00130 TLZN T4,ST.PGM ;IS THIS A PROGRAM NAME
00140 JRST [JUMPE T4,SY2VL4;IGNORE ZEROS
00150 TLO DL,DL.PNF;SET FLAG
00160 JRST .+1] ;BACK TO MAIN LOOP
00170 CAMN T4,T1 ;IS THIS A HIT
00180 JRST SY2VL6 ;YES--WE WIN (MAYBE)
00190 SY2VL4: AOBJN T3,.+1 ;ADD 2 TO POINTER
00200 AOBJN T3,.+2 ; AND SEE IF END OF TABLE
00210 MOVE T3,S2VPTR ;END--POINT BACK TO START
00220 SOJG T2,SY2VL3 ;LOOP FOR WHOLE S.T.
00230 SKIPE T3,SYMPTR ;SKIP IF NO S.T. SPECIFIED
00240 TLNE DL,DL.MDL ;SKIP IF NOT MULTIPLY DEFINED
00250 POPJ P, ;SORRY YOU DO NOT WIN TODAY
00260 SY2VL5: MOVE T1,1(T3) ;GET VALUE
00270 JRST .POPJ1 ;SKIP RETURN
00280
00290 SY2VL6: MOVE T4,(T3) ;GET SYMBOL BACK
00300 TLNE T4,ST.SPI ;CAN WE USE IT?
00310 JRST SY2VL4 ;NO--KEEP LOOKING
00320 TLNN T4,ST.GLB ;IS IT A GLOBAL?
00330 TLNN DL,DL.PNF ;OR IN S.T. WE NAMED?
00340 JRST SY2VL5 ;YES--WE WIN
00350 SKIPN T4,SYMPTR ;SKIP IF LOCAL FOUND BEFORE
00360 JRST SY2VL7 ;NONE. STORE THIS AS VALUE
00370 MOVE T4,1(T4) ;GET THIS VALUE
00380 CAME T4,1(T3) ;SAME AS OLD VALUE
00390 TLO DL,DL.MDL ;NO--MUL DEFINED LCL
00400 SY2VL7: HRRZM T3,SYMPTR ;STOR POINTER
00410 JRST SY2VL4 ;KEEP LOOKING
00010 ;SUBROUTINE TO CONVERT A VALUE TO A SYMBOL
00020 ;ARGS: T1=VALUE
00030 ;VALUE: T1=RADIX50 SYMBOL (WITH FLAGS STILL SET)
00040 ; T2=OFFSET FROM CORRECT SYMBOL
00050 VAL2SY: JUMPE T1,.POPJ ;ZERO IS NOT A SYMBOL
00060 SKIPE SYVLEN ;IS SYVTAB SETUP
00070 JRST VL2SY2 ;YES--SKIP THE SORT
00080 PUSH P,T1 ;SAVE T1
00090 PUSHJ P,SYMSRT ;NO--GO SORT SYMBOL TABLE
00100 POP P,T1 ;GET T1 BACK
00110 VL2SY2: MOVE T2,SYVLEN ;T2 IS CURRENT POINTER IN SYVTAB
00120 JUMPE T2,.POPJ ;NOT FOUND IF NO SYMBOLS
00130 MOVE T3,T2 ;T3 IS AMOUNT TO ADJUST T2 BY
00140 PUSHJ P,.SAVE4 ;SAVE P1 AND P2
00150 MOVEI P1,@SYMTAB ;GET THE POINTERS
00160 MOVEI P2,@SYVTAB ; TO SAVE FUTURE TIME
00170 TLZ DL,DL.SNF ;CAUSE FULL SCAN
00180 VL2SY1: AOS T3 ;TAKE CEIL(T3/2)
00190 LSH T3,-1 ;CUT INC IN HALF (BINARY SEARCH)
00200 JUMPE T3,NOSYMB ;DONE IF CUT DOWN TO ZERO
00210 PUSHJ P,FNSYMV ;FIND POINTER TO SYMBOL VALUE
00220 MOVE T4,(C) ;PICK UP VALUE
00230 CAMLE T4,T1 ;IS THIS .GT. WHAT WE WANT?
00240 JRST VL2BIG ;YES--VALUE TOO BIG
00250 CAMN T1,T4 ;IS THIS THE RIGHT VALUE
00260 JRST VL2HIT ;YES--RETURN
00270 ADD T2,T3 ;LOOK FOR BIGGER VALUE
00280 JRST VL2SY3 ; ..
00290 VL2BIG: SUB T2,T3 ;LOOK FOR SMALLER VALUE
00300 SKIPGE T2 ;DEFENSIVE
00310 MOVEI T2,0 ; ..
00320 VL2SY3: CAIE T3,1 ;LAST 2 WORDS?
00330 JRST VL2SY1 ; ..
00340 TLON DL,DL.SNF ;WERE WE HERE BEFORE?
00350 JRST VL2SY1 ;NO--TRY ONE MORE TIME
00360 AOJA T2,NOSYMB ;COUNTERACT EXTRA BUMP
00010 NOSYMB: CAMGE T1,(C) ;IS VALUE OF SYMBOL SMALLER THAN
00020 ; WHAT WE WANT?
00030 SOJA T2,[JUMPL T2,.POPJ ;NO--BACK UP SOME
00040 PUSHJ P,FNSYMV ;GET VALUE AND
00050 JRST .-1] ;RETRY
00060 SKIPG (C) ;SKIP IF STILL POSITIVE
00070 POPJ P, ;NO--THE NO MATCH
00080 MOVE T2,T1 ;COPY VALUE WE WANTED
00090 SUB T2,(C) ;SUBTRACT WHAT WE FOUND
00100 MOVE T1,-1(C) ;PICK UP SYMBOL
00110 CAIGE T2,100 ;TOO BIG?
00120 AOS (P) ;NO--GIVE SKIP RETURN
00130 POPJ P, ;YES-- FAIL
00140
00150 VL2HIT: MOVE T1,-1(C) ;GET THE SYMBOL
00160 SETZ T2,0 ;CLEAR OFFSET
00170 JRST .POPJ1 ;SKIP RETURN
00010 FNSYMV: MOVE C,T2 ;GET INDEX TO VECTOR
00020 LSH C,-1 ;MAKE SMALLER (HALF WORD ADDRESS)
00030 ADD C,P2 ;ADD IN START OF PERMUTATION VECTOR
00040 MOVE T4,(C) ;GET POINTER TO S.T.
00050 TRNN T2,1 ;ODD POINTER?
00060 MOVS T4,T4 ;NO--SWAP HALVS
00070 MOVEI C,1(P1) ;GET POINTER TO VALUES
00080 ADDI C,(T4) ;ADD IN OFFSET
00090 POPJ P, ;RETURN
00010 ;ROUTINE TO FIX UP POINTERS TO LOCAL S.T. WITHIN SYMBOL TABLE
00020
00030 FIXSYM: TLZN DL,DL.FBR ;IS SYMBOL TABLE O.K. ?
00040 POPJ P, ;YES--RETURN
00050 PUSHJ P,.SAVE2 ;SAVE SOME AC'S
00060 MOVN T1,SYMLEN ;GET -VE LENGTH OF S.T.
00070 HRLZ T1,T1 ;PUT IN L.H.
00080 HRRI T1,@SYMTAB ;PUT IN POINTER TO TABLE
00090 MOVEM T1,S2VPTR ;SAVE FOR LATER
00100 MOVEI T1,^D100 ;NUMBER OF LOCAL S.T.
00110 MOVEI P2,SYNNDX ;GET INDEX
00120 PUSHJ P,GETCOR
00130 MOVEI T1,^D100 ;NUMBER OF LOCAL S.T.
00140 MOVEI P2,SYPNDX ;EXPAND LOCAL S.T.
00150 PUSHJ P,GETCOR ; ..
00160 MOVEI P1,@SYNTAB ;POINTER TO NAME TABLE
00170 MOVEI P2,@SYPTAB ;POINTER TOPOINTER TABLE
00180 SOS P1 ;FIX P1 AND P2 SO THEY
00190 SOS P2 ; CAN BE USED AS PUSH DOWN POINTERS
00200 MOVE T4,S2VPTR ;POINTER TO S.T.
00210 HLLZ T2,T4 ;COPY INDEX TO START OF S.T.
00220 PUSH P2,T2 ; AND STORE AS FIRST POINTER
00230 FXSYM1: MOVE T1,(T4) ;GET SYMBOL
00240 TLNN T1,ST.PGM ;IS IT A PROGRAM NAME
00250 CAIN T1,0 ; ..
00260 JRST FXSYM2 ;NO--SCAN OVER MORE SYMBOLS
00270 PUSH P1,T1 ;SAVE NAME
00280 MOVE T2,T4 ;COPY POINTER
00290 SUBI T2,@SYMTAB ;CONVERT BACK TO RELATIVE POINTER
00300 ADD T2,[2,,2] ;POINT PAST PROGRAM NAME
00310 SKIPGE T2 ;SKIP IF WE ARE NOW DONE
00320 PUSH P2,T2 ;SAVE INDEX
00330 FXSYM2: AOBJN T4,.+1 ;BUMP POINTER
00340 AOBJN T4,FXSYM1 ;LOOP FOR ALL SYMBOLS
00010 HLRZ P1,P1 ;GET SIZE OF TABLE
00020 CAIL P1,^D100 ;TOO BIG?
00030 JRST [M.FAIL <TOO MANY PROGRAMS LOADED>
00040 ]
00050 MOVE T1,SYPLEN ;GET LENGTH OF POINTERS
00060 CAME T1,SYNLEN ;COMPARE WITH NAMES
00070 JRST [M.FAIL <BAD SYMBOL TABLE>
00080 ]
00090 MOVEI T1,^D100 ;ORIGINAL SIZE
00100 SUBB T1,P1 ;NUMBER OF FREE WORDS
00110 MOVEI P2,SYNNDX ;GET INDEX TO TABLE
00120 PUSHJ P,GIVCOR ;RETURN CORE
00130 MOVE T1,P1 ;GET SIZE AGAIN
00140 MOVEI P2,SYPNDX ;GET POINTER TO OTHER TABLE
00150 PJRST GIVCOR ;RETURN
00010 ;HERE TO GIVE BACK SYMBOL TABLE OVERHEAD LISTS
00020
00030 GIVSYM: TLO DL,DL.FBR ;NOTE ST POINTERS ARE JUNK
00040 PUSHJ P,.SAVE2 ;SAVE P1 AND P2
00050 MOVE T1,SYVLEN ;GET LENGTH OF PERMUTATION VECTOR
00060 MOVEI P2,SYVNDX ;GET INDEX
00070 PUSHJ P,GIVCOR ;GIVE BACK CORE
00080 MOVEI P2,SYPNDX ;GIVE BACK POINTER TABLE
00090 MOVE T1,SYPLEN ; ..
00100 PUSHJ P,GIVCOR ; ..
00110 MOVEI P2,SYNNDX ;GIVE BACK NAME TABLE
00120 MOVE T1,SYNLEN ; ..
00130 PJRST GIVCOR ; ..
00010 SUBTTL SYMBOL TABLE LOGIC -- SORT ROUTINE
00020
00030 ;THIS IS A PERMUTATION VECTOR SORT FIRST DESCRIBED BY
00040 ; LUTHER WOODRUM IN VOL. 8 NO. 3 OF THE IBM SYSTEMS
00050 ; JOURNAL. THIS VERSION WAS DERIVED FROM A FORTRAN
00060 ; SUBROUTINE WRITTEN BY TIM TOMASELLI, VICTOR TRIOLO
00070 ; AND CLIVE DAWSON. THE ORIGINAL VERSION WAS WRITTEN
00080 ; IN APL.
00090
00100 APLSRT: PHASE IBUF ;IMPURE CODE
00110
00120 A=123456 ;UNIQUE NUMBER TO PATCH TO BE @SYMTAB
00130 V=707070 ;UNIQUE NUMBER TO PATCH TO BE @SYVTAB
00140
00150 SETZ P1, ;GLOBAL POINTER TO FIRST UNPROCESSED
00160 ; ELEMENT.
00170 MOVE N,SYMLEN ;N _ SIZE OF S.T.
00180 LSH N,-1 ;FIX TO ALLOW FOR 2 WORD ENTRIES
00190 JUMPE N,.POPJ ;CAN NOT SORT ZERO LENGTH S.T.
00200 PUSHJ P,MP ;SORT IT
00210 POP P,T2 ;GET HEADER TO LIST
00220 SETZ T3, ;CLEAR ITEM NUMBER
00230 A7:! MOVE T1,T2 ;COPY LINK
00240 MOVE T2,V(T1) ;GET NEXT ITEM
00250 MOVEM T3,V(T1) ;STORE INDEX IN ITEM
00260 CAME T1,T2 ;DONE (LAST LINK POINTS TO SELF)
00270 AOJA T3,A7 ;NO--KEEP UNLINKING
00280 MOVN T3,SYVLEN ;GET -VE SIZE
00290 HRLZS T1,T3 ;FLIP POINTER AROUND
00300 I1:! MOVE T4,V(T3) ;SET V[V[I]] _ I
00310 HRLM T3,V(T4) ; WITHOUT DISTURBING V[I]
00320 AOBJN T3,I1 ;LOOP FOR WHOLE ARRAY
00330 MOVSI P2,(POINT 18,0) ;BYTE POINTER TO
00340 ADDI P2,V ; PERMUTATION VECTOR.
00350 MOVE T2,[A,,V] ;VERY RARE SYMBOL VALUE TO INIT
00360 MOVEM T2,SAVSYM ; MEMORY WORD.
00370 I2:! HLRZ T2,V(T1) ;GET INDEX INTO SYMTAB
00380 LSH T2,1 ;EXPAND BACK AGAIN
00010 ;ISSPD: IS USED TO GET AT SYMBOL
00020 ; IT POINTS TO THE PASSIVE PART
00030 ; OF THE DATA(SYMBOL) IT IS 1 LESS
00040 ; THAN ALL THE OTHER "A"'S WHICH
00050 ; POINT TO THE VALUE.
00060 ISSPD:! MOVE T4,A(T2) ;GET SYMBOL
00070 TLNE T4,ST.PGM ;PROGRAM NAME?
00080 TLNE T4,ST.SPD ;SPD FLAG ON?
00090 JRST I3 ;YES--PROGRAM NAME ON KILLED ON OUTPUT
00100 MOVE T4,A(T2) ;GET SYMBOL VALUE
00110 CAMN T4,SAVSYM ;SAME VALUE?
00120 JRST I3 ;YES--LOOP FOR NEXT ***TEMP***
00130 MOVEM T4,SAVSYM ;NO--THIS IS NE LAST SYMBOL
00140 IDPB T2,P2 ;ELSE STORE IN VECTOR
00150 I3:! AOBJN T1,I2 ;LOOP OVER WHOLE TABLE
00160 IDPB T2,P2 ;STORE A PAD BYTE IF NEEDED
00170 MOVEI T1,1(P2) ;GET SIZE OF FINAL VECTOR
00180 SUBI T1,V ;GET BACK TO RELATIVE ADDRESS
00190 MOVNS T1 ;MAKE CURRENT LENGTH -VE
00200 ADD T1,SYVLEN ;ADD IN OLD LENGTH SO RESULT IS
00210 ; AMOUNT TO GIVE BACK.
00220 MOVEI P2,SYVNDX ;GET ITS INDEX
00230 PJRST GIVCOR ;RETURN WHAT WE DO NOT NEED
00010 MP: CAIN N,1 ;CAN THIS LINK BE FORMED?
00020 JRST BOTTOM ;YES - JUMP OUT
00030 PUSH P,N ;SAVE 'N' FOR LATER
00040 ASH N,-1 ;FLOOR(N/2)
00050 PUSHJ P,MP ;SOME RECURSION IS GOOD FOR THE SOUL
00060 POP P,N ;GET 'N' BACK
00070 EXCH N,(P)
00080 ADDI N,1 ;CIELING OF (N/2)
00090 ASH N,-1 ; ..
00100 PUSHJ P,MP ;MORE RECURSION
00110 JRST MERGE ;MERGE ANY CHAINS THAT EXIST
00120 BOTTOM:!MOVEM P1,V(P1) ;V[P1] _ P1 (LINK TO SELF)
00130 PUSH P,(P) ;THERE MUST BE A REASON FOR
00140 MOVEM P1,-1(P) ; THESE 2 INSTRUCTIONS.
00150 AOJA P1,.POPJ ;P1_P1+1 AND RETURN
00160
00170 MERGE:! POP P,T1 ;M1.
00180 POP P,T2
00190 MOVE C,T2 ;COPY INDEX
00200 LSH C,1 ;POINT TO VALUE
00210 MOVE T3,A(C) ;SEE IF A[J] < A[I]
00220 MOVE C,T1 ;COPY INDEX
00230 LSH C,1 ;POINT TO VALUE
00240 CAMGE T3,A(C) ;SEE WHICH IS BIGGER
00250 EXCH T1,T2 ;EXCHANGE THE INDICIES
00260 PUSH P,(P) ;STORE T1 ON
00270 MOVEM T1,-1(P) ; STACK
00280 M2:! CAME T1,V(T1) ;M2. [END OF CHAIN] IF P[T1] = T1
00290 JRST M3 ;NO--KEEP DOING
00300 MOVEM T2,V(T1) ;SET V[T1] _ T2
00310 POPJ P, ;RETURN
00320
00330 M3:! MOVE T4,T1 ;M3. [ADVANCE] SET T4 _ T1
00340 MOVE T1,V(T1) ;I _ V[I]
00350 MOVE T3,T1 ;GET INDEX
00360 LSH T3,1 ;FIX FOR TABLE SIZE
00370 MOVE T3,A(T3) ;SEE IF STIILL IN ORDER
00380 MOVE C,T2
00390 LSH C,1
00400 CAMGE T3,A(C) ;IF A[T1] < A[T2]
00410 JRST M2 ;GOTO M2
00420 M4:! MOVEM T2,V(T4) ;M4. SET V[T4] _ T2
00430 EXCH T1,T2 ;SWAP AROUND INDICIES
00440 JRST M2
00450 SAVSYM:!BLOCK 1
00460 DEPHASE
00470 APLSIZ==.-APLSRT
00010
00020 SYMSRT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
00030 MOVE T1,SYMLEN ;GET SIZE OF SYMBOL TABLE
00040 LSH T1,-1 ;CUT IN HALF
00050 MOVEI P2,SYVNDX ;INDEX TO TABEL VECTOR
00060 PUSHJ P,GETCOR ;GO GET THE CORE WE NEED
00070 MOVE T1,[APLSRT,,IBUF];BLT POINTER
00080 BLT T1,IBUF+APLSIZ ;COPY THE CODE
00090 MOVEI T1,@SYMTAB ;POINTER TO SYMBOLS
00100 ADDI T1,1 ;CAUSE TO POINT TO VALUE WORD
00110 MOVEI T2,@SYVTAB ;POINTER TO PERMUTATION VECTOR
00120 MOVE T3,[-APLSIZ,,IBUF] ;AOBJN POINTER
00130 SYNSR1: HRRZ T4,(T3) ;GET Y ADDRESS
00140 CAIN T4,V ;ADDRESS IN PERMUTATION VECTOR
00150 MOVEI T4,(T2) ;YES--FIX POINTER
00160 CAIN T4,A ;ADDRESS IN SYMBOL TABLE?
00170 MOVEI T4,(T1) ;YES--DO THAT TOO
00180 HRRM T4,(T3) ;STORE BACK
00190 AOBJN T3,SYNSR1 ;LOOP FOR ALL CODE BLTED
00200 SOS ISSPD ;FIX THE ONE LOOSER
00210 JRST IBUF ;GO DO THE SORT
00010 SUBTTL OP DECODER
00020
00030 ;DESCRIPTION OF OP DECODER FOR DUMP:
00040 ;
00050 ; THE ENTIRE INSTRUCTION SET FOR THE PDP-10 CAN BE COMPACTED INTO
00060 ;A SPACE MUCH SMALLER THAN ONE REGISTER FOR EVERY SYMBOL. THIS OCCURS
00070 ;BECAUSE OF THE MACHINE ORGANIZATION AND INSTRUCTION MNEMONICS CHOSEN
00080 ;FOR THE PDP-10. FOR EXAMPLE, IF BITS (0-2) OF AN INSTRUCTION EQUAL
00090 ;101(2) THE INSTRUCTION IS A HALF WORD INSTRUCTION AND AN "H" MAY
00100 ;BE ASSUMED. "T" MAY BE ASSUMED FOR ALL TEST INSTRUCTIONS (WHICH
00110 ;BEGIN WITH 110(2).
00120 ;
00130 ; THE TABLE TBL IN DUMP CONSISTS OF 9 BIT BYTES, 4 TO A WORD.
00140 ;THE NUMBERS IN THE BYTES HAVE THE FOLLOWING SIGNIFICANCE:
00150 ;0-37(8): THIS IS A DISPATCH COMMAND FOR THE OP-DECODER INTERPRETER.
00160 ; LET THE RIGHT MOST TWO BITS EQUAL N; LET THE NEXT 3 BITS
00170 ; EQUAL P.
00180 ;
00190 ; THE CONTENTS OF P2 (INSTRUCTION) CONTAIN IN THE RIGHT
00200 ; MOST NINE BITS THE BINARY FOR THE MACHINE INSTRUCTION.
00210 ; P AND N REFER TO THE CONTENTS OF P2, AND THE OP DECODER
00220 ; WILL PRODUCE AN ANSWER D GIVEN P, N, AND THE CONTENTS
00230 ; OF P2X N+1 GIVES THE NUMBER OF BITS IN P2; P GIVES THE
00240 ; POSITION (FROM THE RIGHT EDGE) OF THE N+1 BITS.
00250 ;
00260 ; EXAMPLE: P = 6
00270 ; N = 2
00280 ;
00290 ;; C(P2) = .010 101 100(2)
00300 ;
00310 ; THE RESULT = D = 010(2) = 2(8)
00320 ;
00330 ; D IS USED AS A DISPATCH ON THE NEXT BYTES IN THE TABLE.
00340 ; IF D = 5, 5 BYTES IN THE TABLE (DON'T COUNT THE BYTES WHICH
00350 ; PRINT TEXT OR ARE THE EXTEND BYTE, 41-73(8))
00360 ; ARE SKIPPED OVER AND THE 6TH BYTE RESUMES
00370 ; THE INTERPRETATION.
00380 ;
00390 ;40(8) THIS IS A STOP CODE; WHEN THIS IS REACHED INTERPRETATION
00400 ; IS FINISHED.
00410 ;41(8)-72(8) THE ALPHABET IS ENCODED INTO THIS RANGE.
00420 ; 41- A
00430 ; 42- B
00440 ; 72- Z
00450 ; WHEN A BYTE IN THIS RANGE IS REACHED, ITS CORRESPONDING
00460 ; LETTER IS TYPED.
00010 ;73(8) THIS IS THE "EXTEND" BYTE. THE NEXT BYTE IN THE TABLE
00020 ; IS A TRANSFER BYTE BUT MUST HAVE THE ADDRESS EXTENDED
00030 ; BY <1000-74*2+FIR.> FIRST.
00040 ;
00050 ;74(8)-777(8) THIS IS A TRANSFER BYTE. IF THE BYTE IN THIS RANGE IS
00060 ; CONSIDERED TO BE A, TRANSFER INTERPRETATION TO THE
00070 ; <A-74(8)+FIR.>RD BYTE IN THE TABLE.
00080 ;
00010 DEFINE BYT9 (A) <IRP A,<
00020 A>>
00030
00040 IF1,<
00050
00060 DEFINE .ADR (A) <
00070 %'A== CLOC
00080 FIR.== CLOC
00090 DEFINE .ADR (B) <
00100 %'B== CLOC
00110 LASTB==CLOC+74-FIR.>>
00120
00130 DEFINE .TRA (A)<CLOC==CLOC+1>
00140 DEFINE .TRAX (A)<CLOC==CLOC+2>
00150
00160 SYN .TRA, .DIS
00170
00180 DEFINE .TXT (A) <
00190 IFNB <A>, <IRPC A,<CLOC==CLOC+1>>>
00200
00210 DEFINE .END (A) <
00220 IFNB <A>, <IRPC A,<CLOC==CLOC+1>>
00230 CLOC== CLOC+1>
00240
00250 > ;END OF IF1
00260 IF2,<
00270
00280 DEFINE .ADR (A)<IFN %'A-CLOC,<PRINTX PHASE ERR AT: %'A>>
00290
00300 DEFINE .TRA (A) <OUTP %'A+74-FIR.>
00310
00320 DEFINE .TRAX (A),<OUTP 73
00330 OUTP 74+<Z1==%'A-FIR.-1000+74>
00340 IFL Z1,<PRINTX "A" TOO SMALL FOR .TRAX>>
00350
00360 DEFINE .DIS (A) <OUTP A&70/2+A&7-1>
00370
00380 DEFINE .TXT (A) <IFNB <A>,<IRPC A,<OUTP "A"-40>>>
00390
00400 DEFINE .END (A) <
00410 IFNB <A>, <IRPC A,<OUTP "A"-40>>
00420 OUTP 40>
00430
00440 DEFINE OUTP (A)<
00450 IFGE <A>-1000,<PRINTX OPTABLE BYTE "A" TOO BIG>
00460 IFE <BINC==BINC-9>-^D27,<BINR1==A>
00470 IFE BINC-^D18,<BINR2==A>
00480 IFE BINC-9,<BINR3==A>
00490 IFE BINC,< BYTE (9) BINR1,BINR2,BINR3,<A>
00500 BINC==^D36>
00510 CLOC==CLOC+1 >
00520 >
00010 TBL: ;OPDECODER BYTE TABLE
00020
00030 XALL
00040 IFDEF .XCREF <.XCREF>
00050
00060
00070 CLOC== 0 ;SET BYTE LOCATION COUNTER TO 0
00080 BINC== ^D36 ;INIT BYTES/WORD COUNTER
00090 IF1,< DEFINE BYTABL,<
00100 XLIST
00110
00120 ;**********THE ARGUMENT FOR THE FOLLOWING "BYT9" MACRO
00130 ;**************TERMINATES AT THE NEXT COMMENT WITH: **************
00140
00150 BYT9 <
00160 LIST
00170
00180 .DIS 63,.TRA UUO,.TRA FLO,.TRA HAK,.TRA ACCP,.TRA BOOLE
00190 .TXT H,.TRA HWT,.TXT T,.TRA ACBM
00200
00210
00220 ;IO INSTRUCTIONS
00230
00240 .DIS 21,.TRA BD,.TXT CON,.DIS 11,.TRA OI,.TXT S,.DIS 01,.TRA Z,.TRA O
00250 .ADR BD,.DIS 01,.TXT BLK,.TRA IO,.TXT DATA,.ADR IO,.DIS 11,.TRA I,.TRA O
00260 .ADR OI,.DIS 01,.TRA O,.TRA I
00270 ;UUOS
00280
00290 .ADR UUO,.DIS 51,.END,.TXT,.DIS 32,.TRA U40,.TRAX U50,.TRA U60
00300 .DIS 21,.TRAX U703,.DIS 11,.TRA USET,.DIS 01
00310 .TXT LOOKU,.TRA P,.TXT ENTE,.TRA R,.ADR USET,.TXT USET,.DIS 01,.TRA I,.TRA O
00320 .ADR U40,.DIS 03,.TRAX CAL,.TXT INI,.TRA T,.END,.END,.END,.END,.END,.TXT CALL,.TRA I
00330 .ADR U60,.DIS 21,.TRA U603,.DIS 01,.TXT IN,.TRA BPUT,.TXT OUT
00340 .ADR BPUT,.DIS 11,.TXT BU,.ADR F,.END F,.TXT,.TXT PU,.TRA T
00350 .ADR U603,.DIS 01,.TRA U6062,.TXT STAT,.DIS 11,.ADR O,.END O,.TXT,.ADR Z,.END Z,.TXT
00360 .ADR U6062,.DIS 11,.TXT S,.TRA U62,.TXT G,.ADR U62,.TXT ETST,.TRA S
00370
00380 ;BYTE AND FLOATING INSTRUCTIONS
00390
00400 .ADR FLO,.DIS 51,.TRA BYTE,.TXT F,.DIS 32,.TXT,.TXT AD,.TRA A,.TXT SB
00410 .TRA A,.TXT MP,.TRA A,.TXT DV,.ADR A
00420 .DIS 21,.TRA LMB,.TXT R,.TRA IMB,.ADR LMB,.DIS 02,.END,.TXT
00430 .ADR L,.END L,.TXT,.ADR M,.END M,.TXT
00440 .ADR B,.END B,.TXT,.ADR BYTE,.DIS 32,.END,.TRAX I110,.TRA I120,.TXT
00450 .DIS 03,.TXT UF,.TRA PA,.TXT DF,.TRA N
00460 .TXT FS,.TRA CTYP,.TXT IB,.ADR P,.END P,.TXT,.TXT I,.TRA LD
00470 .ADR LD,.TXT LD,.TRA B,.TXT I,.TRA DP,.ADR DP,.TXT DP,.TRA B
00010 ;FWT-FIXED POINT ARITH-MISC
00020
00030 .ADR HAK,.DIS 33,.TRA MV,.ADR MV,.TXT MOV,.TRA MO,.TRA ML,.TRA DV
00040 .TRA SH,.TRA H1,.TRA JP
00050 .DIS 21,.TXT ADD,.TRA IMB,.TXT SU,.ADR BIMB,.TXT B,.ADR IMB,.DIS 02,.END,.TXT
00060 .ADR I,.END I,.TXT,.TRA M,.TRA B,.ADR MO,.DIS 22
00070 .ADR EIMS,.TXT E,.TRA IMS,.TXT S,.TRA IMS,.TXT N,.TRA IMS,.TXT M
00080 .ADR IMS,.DIS 02,.END,.TXT,.TRA I,.TRA M,.ADR S,.END S,.TXT
00090 .ADR ML,.DIS 21,.TXT I,.TRA ML1,.ADR ML1,.TXT MUL,.TRA IMB
00100 .ADR DV,.DIS 21,.TXT I,.TRA DV1
00110 .ADR DV1,.TXT DI,.ADR DV2,.TXT V,.TRA IMB,.ADR H1,.DIS 03,.TXT EXC,.TRA S3,.TXT BL
00120 .ADR T,.END T,.TXT,.TRA AO,.ADR AO,.TXT AOBJ
00130 .TRA AOB,.TXT JRS,.TRA T,.TXT JFC,.TRA L,.TXT XC,.TRA T,.TXT MA,.TRA P
00140 .ADR AOB,.DIS 01,.TRA P,.TRA N
00150 .ADR JP,.DIS 03,.TRA PU,.ADR PU,.TXT PUSH,.TRA PUS,.TRA PO
00160 .ADR PO,.TXT POP,.TRA POP,.TXT JS,.ADR R,.END R,.TXT
00170 .TXT JS,.TRA P,.TXT JS,.ADR PA,.END A,.TXT,.TXT JR,.TRA PA
00180 .ADR PUS,.DIS 01,.ADR J,.END J,.END,.TXT,.ADR POP
00190 .DIS 01,.END,.TXT,.TRA J,.ADR SH,.DIS 02,.TXT A,.TRA S2,.TXT ROT,.TRA S1,.TXT L
00200 .ADR S2,.TXT S,.ADR S3,.TXT H,.TRA S1,.DIS 21,.TXT JFF,.TRA O,.END
00210 .ADR S1,.DIS 21,.END,.TXT,.ADR CTYP,.END C,.TXT
00220
00230 ;ARITH COMP-SKIP-JUMP
00240
00250 .ADR ACCP,.DIS 42,.TXT CA,.TRA CA1,.TRA SJ,.TXT A,.TRA JS,.TXT S
00260 .ADR JS,.TXT O,.DIS 31
00270 .TXT J,.TRA COMP,.TXT S,.TRA COMP,.ADR CA1,.DIS 31,.TXT I,.TRA COMP,.TXT M,.TRA COMP
00280 .ADR SJ,.DIS 31,.TXT JUM,.TRA PSJ,.TXT SKI,.ADR PSJ,.TXT P,.ADR COMP
00290 .DIS 03,.END,.TXT,.TRA L,.ADR E,.END E,.TXT,.TXT L,.TRA E,.TRA PA,.TXT G,.TRA E
00300 .ADR N,.END N,.TXT,.END G,.TXT
00010 ;HALF WORDS
00020
00030 .ADR HWT,.DIS 51,.TRA HW1,.DIS 21,.TXT R,.TRA HW2,.TXT L,.ADR HW2,.TXT R,.TRA HW3
00040 .ADR HW1,.DIS 21,.TXT L,.TRA HW4,.TXT R,.ADR HW4,.TXT L
00050 .ADR HW3,.DIS 32,.TRA IMS,.TXT Z,.TRA IMS,.TXT O,.TRA IMS,.TRA EIMS
00060
00070 ;TEST INSTRUCTIONS
00080
00090 .ADR ACBM,.DIS 31,.TRA AC1,.DIS 01,.TXT D,.TRA AC2,.TXT S,.TRA AC2
00100 .ADR AC1,.DIS 01,.TXT R,.TRA AC2,.TXT L
00110 .ADR AC2,.DIS 42,.TXT N,.TRA EAN,.TXT Z,.TRA EAN,.TXT C,.TRA EAN,.TXT O
00120 .ADR EAN,.DIS 12,.END,.TXT,.TRA E,.TRA PA,.TRA N
00130
00140 ;BOOLEAN
00150
00160 .ADR BOOLE,.DIS 24,.TRA ST,.ADR AN,.TXT AND,.TRA B2,.TRA AN,.TRA ST,.TRA AN,.TRA ST
00170 .TXT X,.ADR OR,.TXT OR,.TRA B2,.TXT I,.TRA OR,.TRA AN,.TXT EQ
00180 .TRA DV2,.TRA ST,.TRA OR,.TRA ST,.TRA OR,.TRA OR
00190 .ADR ST,.TXT SET,.ADR B2,.DIS 24,.TXT Z,.TRA IMB,.TRA IMB
00200 .ADR CA,.TXT C,.TRA TA,.ADR TM,.TXT M,.TRA IMB
00210 .ADR CM,.TXT C,.TRA TM,.ADR TA,.TXT A,.TRA IMB,.TRA IMB,.TRA IMB
00220 .ADR CB,.TXT C,.TRA BIMB,.TRA IMB,.TRA CA
00230 .TRA CA,.TRA CM,.TRA CM,.TRA CB,.TXT O,.TRA IMB
00010 ;INSTRUCTION GROUP 120
00020 .ADR I120,.DIS 11,.TRA DMOV,.DIS 01,.TXT FIX,.TRA FIX2,.DIS 21,.END
00030 .TXT FLT,.ADR FIX2,.DIS 21,.END,.TRA R
00040 .ADR DMOV,.TXT DMOV,.DIS 01,.TXT E,.TRAX EM,.TXT N
00050 .ADR EM,.DIS 21,.END,.TRA M
00060
00070 ;MORE UUO'S
00080
00090 .ADR U50,.DIS 03,.TXT OPE,.TRA N,.TXT TT,.ADR CAL,.TXT CAL,.TRA L,.END,.END,.END
00100 .TXT,.TXT RENAM,.TRA E,.TXT I,.TRA N,.TXT OU,.TRA T
00110 .ADR U703,.DIS 02,.TXT CLOS,.TRA E,.TXT RELEA,.TRA S
00120 .TXT MTAP,.TRA E,.TXT UGET,.TRA F
00130
00140 ;INSTRUCTION GROUP 110 - DF ARITHMETIC
00150 .ADR I110,.DIS 21,.TXT DF,.TRAX DF,.END,.ADR DF,.DIS 02
00160 .END AD,.END SB,.TXT M,.TRA P,.END DV
00170
00180 ;**********THIS TERMINATES THE "BYT9" MACRO ARGUMENT******
00190 >>>
00010 BYTABL
00020 IF1,< BLOCK <CLOC+3>/4>
00030 IF2,< IFN BINC-^D36,<BYTE (9) BINR1,BINR2,BINR3,0> >
00040
00050 IFNDEF CLOC.,<CLOC.==CLOC>
00060 IFN CLOC.-CLOC,<PRINTX PHASE ERROR IN OPTABLE>
00070
00010 IF2,<
00020 DEFINE .ADR (A) <
00030 PURGE %'A
00040 >
00050 DEFINE .DIS (A)<>
00060 DEFINE LIST <>
00070 DEFINE .TRA (A)<>
00080 DEFINE .TRAX (A)<>
00090 DEFINE .TXT (A)<>
00100 DEFINE .END (A)<>
00110 BYTABL
00120 PURGE LIST
00130 LIST
00140 PURGE BINR1,BINR2,BINR3,OUTP,CLOC,CLOC.,BINC,Z1
00150 PURGE .TRA,.TRAX,.TXT,.END,BYT9,BYTABL
00160 > ;END IF2
00170 IFDEF .CREF <.CREF>
00010 ;CALLI NAMES
00020
00030 DEFINE S(A)<
00040 IRP A,<
00050 XLIST
00060 <SIXBIT /A/>
00070 LIST
00080 >>
00090
00100 MAXNCI==.-CITAB
00110 S <LIGHTS>;
00120 CITAB: S <RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT>; ;0 TO 5
00130 S <GETCHR,DDTRL,WAIT,CORE,EXIT,UTPCLR,DATE>; ;6 TO 14
00140 S <LOGIN,APRENB,LOGOUT,SWITCH,REASSI,TIMER>; ;15 TO 22
00150 S <MSTIME,GETPPN,TRPSET,TRPJEN,RUNTIM,PJOB>; ;23 TO 30
00160 S <SLEEP,SETPOV,PEEK,GETLIN,RUN,SETUWP,REMAP>; ;31 T0 37
00170 S <GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR>; ;40 TO 45
00180 ;END OF 4.72 CALLIS
00190
00200 S <SYSSTR,JOBSTR,STRUUO,SYSPHY,FRECHN,DEVTYP>; ;46 TO 53
00210 S <DEVTYP,DEVPPN,SEEK>; ;54 AND 55
00220
00230 ;END OF 5.01 CALLIS
00240
00250 S <RTTRP,LOCK,JOBSTS,LOCATE,WHERE,DEVNAM,CTLJOB>; ;56 TO 65
00260 S <GOBSTR,ACTIVA,DEACTI>; ;66 TO 70
00270
00280 ;END OF 5.02 CALLIS
00290
00300 S <HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN,OTHUSR>;;71 TO 77
00310 S <CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN>; ;100 TO 105
00320 S <FRCUUO,DEVLNM>; ;106 TO 107
00330
00340 ;END OF 5.03 CALLIS
00350
00360 S <PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.>; ;110 TO 115
00370 S <TRMOP.,RESDV.,UNLOK.>; ;116 TO 120
00380 ;END OF 5.04 CALLIS
00390
00400 S <DISK.,DVRST.,DVURS.>
00410 MAXCAL==.-CITAB-1
00010 BTAB: POINT 9,TBL ;TABLE USED TO GET NEXT BYTE POINTER
00020 POINT 9,TBL,8 ;FOR TRANSFER BYTE
00030 POINT 9,TBL,17
00040 POINT 9,TBL,26
00050
00060
00070 ;SUBROUTINE TO LOOKUP AN OPCODE IN THE TABLE AND RETURN ITS
00080 ; SIXBIT NAME
00090 ;ARG: T1=BINARY WORD
00100 ;VALUE: N=SIXBIT VALUE
00110 ;
00120 ; SKIP RETURNS IF VALID OPCODE ELSE JUST POPJ RETURN
00130 ;
00140 OPDEC: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
00150 MOVE N,LASTOP ;GET LAST OPCODE
00160 CAMN T1,LASBIN ;IS THIS THE SAME
00170 JRST DCODEX ;YES--GIVE SAME ANSWER
00180 MOVEM T1,LASBIN ;STORE FOR NEXT TIME
00190 MOVEI P1,P2 ;POINT TO OPCODE
00200 MOVE P2,T1 ;PLACE OPCODE SOMEPLACE SAFE
00210 LSH P2,-33 ;JUST WANT OPCODE
00220 CAIE P2,47 ;IS THIS A CALLI?
00230 JRST NTCALL ;NO--LOOK UP IN TBL:
00240 HRREI T1,(T1) ;GET ACT VALUE
00250 CAML T1,[MAXNCI] ;SMALLER THAN MIN.
00260 CAILE T1,MAXCAL ;BIGGER THAN MAX.
00270 JRST NTCALL ;YES--JUST SAY CALLI
00280 MOVE N,CITAB(T1) ;NO--GET REAL NAME
00290 MOVEM N,LASTOP ;REMEMBER THIS FOR NEXT TIME
00300 PJRST .POPJ1 ;RETURN
00310 NTCALL: SETZ N, ;CLEAR ANSWER
00320 MOVE C,[POINT 6,N] ;POINTER TO ANSWER
00330 SETZB T2,T3 ;CLEAR TEMP AC'S
00340 MOVE T4,BTAB ;POINT TO TABLE
00350 DCODE1: ILDB T1,T4 ;GET A BYTE
00360 CAILE T1,40 ;SKIP IF 0-40 (DISPATCH OR STOP CODE)
00370 CAIL T1,74 ;SKIP IF TRANSFER BYTE
00380 SOJGE T2,DCODE1 ;0-40 OR TRANSFER BYTE LOOP FOR
00390 ; C(T2) MORE BYTES.
00400 JUMPG T2,DCODE1 ;JUMP IF DISPATCH AND T2 .GT. 0
00410 SUBI T1,40 ;KNOCK DOWN CODE BY 40.
00420 JUMPE T1,DCODEX ;JUMP IF STOP CODE
00430 JUMPG T1,DCODE2 ;JUMP IF LETTER OR TRANSFER
00440 DPB T1,[POINT 5,P1,7];MAKE P1 POINT TO NEXT
00450 TRZ T1,-4 ; GROUP OF BITS IN
00460 AOS T1 ; THE OPCODE FIELD.
00470 DPB T1,[POINT 6,P1,11]
00480 LDB T2,P1 ;GET THE BITS
00490 JRST DCODE1 ;LOOP FOR THIS PART OF OPCODE
00010 DCODE2: HRREI T1,-33(T1) ;TOTAL SUBTRACTED IS NOW 73.
00020 JUMPL T1,DECT ;SO -VE NUMBERS ARE LETTERS.
00030 JUMPG T1,DCODE3 ;AND POSITIVE NUMBERS ARE TRANSFERS.
00040 ILDB T1,T4 ;ZERO(73) IS SPECIAL HACK TO LET US
00050 MOVEI T1,611(T1) ; GET MORE INTO TABLE FOR KI-10.
00060 DCODE3: MOVEI T3,FIR.-1(T1) ;FIR. IS FIRST BYTE WE NEED TO "GOTO"
00070 ; SO ALL ADDRESSES ARE KEYED OFF FIR.
00080 IDIVI T3,4 ;9-BIT BYTES. 4 BYTES/WORD.
00090 MOVE T4,BTAB(T4) ;BYTE POINTER TO WHERE WE JUST JRSTED
00100 ADDI T4,(T3) ;ADD IN WORD ADDRESS (OFFSET)
00110 JRST DCODE1 ;LOOP TO LOOK AT THAT BYTE.
00120
00130 DECT: MOVEI T1,73(T1) ;CONVERT BACK TO SIXBIT
00140 IDPB T1,C ;STORE IN N
00150 JRST DCODE1 ;LOOP BACK FOR REST.
00160
00170 DCODEX: MOVEM N,LASTOP ;SAVE FOR NEXT TIME
00180 SKIPE N ;DONE. DID WE STORE ANYTHING?
00190 AOS (P) ;YES--SKIP RETURN
00200 POPJ P, ;NO--PLAIN RETURN
00010 SUBTTL CORE MANAGEMENT SUBROUTINES
00020
00030 ;SUBROUTINE TO EXPAND A TABLE
00040 ;ARGS T1=WORDS TO GET
00050 ; P2=INDEX IN TABLE VECTOR
00060
00070 GETCOR: JUMPE T1,.POPJ ;JUMP IF NO CHANGE
00080 PUSH P,T1 ;SAVE INCREMENT
00090 ADDM T1,LENVEC(P2) ;INCREMENT SIZE OF TABLE
00100 ADDB T1,.JBFF ;AND END OF TABLES
00110 CAMG T1,.JBREL ;SKIP IF MUST EXPAND CORE
00120 JRST GETCR1 ;ALREADY HAVE ENOUGH
00130 CORE T1, ;TRY TO EXPAND CORE
00140 JRST E.NCOR ;CANT GET ENOUGH CORE
00150 GETCR1: CAIN P2,LSTTAB ;SKIP IF NOT LAST TABLE
00160 JRST T1POPJ
00170 MOVE T1,(P) ;RESET INCREMENT
00180 PUSH P,T2
00190 PUSH P,T3
00200 MOVE T2,.JBFF ;T2=NEW LAST ADDRESS OF TABLES
00210 SUB T1,T2 ;T1=-OLD LAST ADDRESS
00220 MOVNS T1 ;T1=OLD LAST ADDRESS
00230 HRLI T1,-1 ;MAKE PUSH DOWN PTR SUITABLE FOR POPS
00240 MOVE T3,TABVEC+1(P2) ;OLD LAST ADDRESS OF NEXT TABLE
00250 GETCR2: POP T1,(T2) ;OLD TO NEW LOCATION
00260 CAIG T3,(T1) ;SKIP IF JUST MOVED FIRST LOC OF TABLE PAST EXPANDED
00270 SOJA T2,GETCR2 ;LOOP TILL DONE
00280 MOVEI T2,1(P2) ;INDEX OF NEXT TABLE
00290 MOVE T1,-2(P) ;RESET INCREMENT
00300 GETCR3: ADDM T1,TABVEC(T2) ;INCREMENT THE START ADDR OF TABLES THAT FOLLOW
00310 CAIE T2,LSTTAB ;SKIP IF INCREMENTED LAST TABLE
00320 AOJA T2,GETCR3 ;LOOP FOR THE REST OF THE TABLES
00330 POP P,T3
00340 POP P,T2
00350 T1POPJ: POP P,T1
00360 POPJ P,
00010 ;SUBROUTINE TO CONTRACT A TABLE
00020 ;ARGS T1=WORDS TO GIVE BACK
00030 ; P2=INDEX IN TABLE VECTOR
00040
00050 GIVCOR: CAMG T1,LENVEC(P2) ;SKIP IF GIVING BACK TOO MUCH
00060 JRST GIVCR1 ;OK
00070 PUSH P,LENVEC(P2) ;SAVE CURRENT LENGTH OF TABLE
00080 MOVEI T1,[ASCIZ .GIVING BACK TOO MUCH CORE .]
00090 PUSHJ P,LSTR
00100 ;TYPE HOW MUCH, CURRENT LENGTH
00110 POP P,T1 ;RESTORE LENGTH TO GIVE BACK=CURRENT LENGTH
00120 GIVCR1: JUMPE T1,.POPJ ;EXIT IF NO CHANGE
00130 MOVNS T1 ;T1=MINUS WORDS TO GIVE BACK
00140 ADDM T1,LENVEC(P2) ;DECREMENT LENGTH OF TABLE
00150 ADDM T1,.JBFF ;AND END OF TABLES
00160 CAIN P2,LSTTAB ;SKIP IF NOT LAST TABLE
00170 JRST GIVCRE ;NO SHUFFLING NEEDED
00180 PUSH P,T2
00190 MOVE T2,TABVEC+1(P2) ;START ADDR OF NEXT TABLE
00200 HRLS T2 ;IN BOTH HALVES
00210 ADD T2,T1 ;RIGHT HALF=NEW START ADDR
00220 BLT T2,@.JBFF ;MOVE UP TABLES PAST THIS TABLE
00230 MOVEI T2,1(P2) ;INDEX OF NEXT TABLE
00240 GIVCR2: ADDM T1,TABVEC(T2) ;DECREMENET START ADDR OF REST OF TABLES
00250 CAIE T2,LSTTAB ;SKIP IF DECREMENTED LAST TABLE
00260 AOJA T2,GIVCR2
00270 POP P,T2
00280 GIVCRE: MOVE T1,.JBREL ;TOTAL SIZE OF CORE
00290 SUB T1,.JBFF ;MINUS LENGTH NEEDED
00300 CAIGE T1,4000 ;SKIP IF MORE THAN 2K EXCESS
00310 POPJ P, ;OK, DONT WORRY
00320 MOVNI T1,2000 ;-1K
00330 ADD T1,.JBREL
00340 CORE T1, ;GIVE BACK 1 K
00350 JFCL
00360 .POPJ: POPJ P,
00010 SUBTTL ERRORS
00020
00030 ;HERE FOR VARIOUS ERRORS
00040
00050 E.NIMP: MOVE N,VERBN(P1) ;NAME OF VERB
00060 M.FAIN <NOT CODED>
00070
00080 E.NCOR: MOVE N,TABNAM(P2) ;NAME OF TABLE THAT WANTED TO EXPAND
00090 M.FAIN <CANT EXPAND TABLE>
00100
00110 E.EXP: M.FAIL <SYNTAX ERROR>
00120
00130 E.MAX: HRLZ N,T1 ;SET MAXIMUM
00140 M.FAIO <MAX =>
00150
00160 E.NSFI: MOVEI N,(DL)
00170 M.FAIF <CANT FIND INPUT FILE - ERROR CODE=>
00180
00190 E.NSFO: MOVEI N,O.ZER
00200 M.FAIF <CANT ENTER OUTPUT FILE>
00210
00220 E.LKO: MOVE N,T2
00230 M.FAIN <OPEN failure for device>
00240
00250 E.LKL: HRLZ N,T2 ;COPY ERROR CODE
00260 M.FAIO <LOOKUP failure for input device - code>
00270
00280 E.STNU: PUSHJ P,TRDX5 ;TYPE IN RADIX 50
00290 MOVEI T1,[ASCIZ / is a undefined symbol table name
00300 /]
00310 PUSHJ P,.TSTRG##
00320 PJRST .FMSGE##
00010 E.SYMF: M.FAIL <Wrong format for symbol (: must be followed by a symbol)>
00020 E.SYMU: PUSHJ P,TRDX5
00030 TLNE DL,DL.MDL
00040 JRST E.SMDL
00050 MOVEI T1,[ASCIZ / is an undefined symbol
00060 /]
00070 pushj p,.tstrg##
00080 pjrst .fmsge##
00090 e.smdl: movei t1,[asciz / is a multiply defined local
00100 /]
00110 PUSHJ P,.TSTRG##
00120 PJRST .FMSGE##
00010 ;SUBROUTINE TO TYPE A RADIX 50 SYMBOL IN CASE WE NEED IT IN AN ERROR
00020
00030 TRDX5: CLRBFI ;PREPARE TO TYPE A ?
00040 PUSH P,T1
00050 MOVEI T1,[ASCIZ /
00060 ? /]
00070 PUSHJ P,.TSTRG##
00080 TLO DL,DL.TR5 ;FLAG OUTPUT TO TTY
00090 POP P,T1
00100 PUSHJ P,$LRAD ;LIST THE SYMBOL
00110 TLZ DL,DL.TR5 ;CLEAR THE FLAG
00120 POPJ P, ;RETURN
00010 SUBTTL LISTS
00020
00030 ;LIST OF EXTENSIONS TO TRY IF NOT KNOWN
00040
00050 DEFINE DEFSYM(A)<
00060 XLIST
00070 IRP A,<SIXBIT \A\>
00080 LIST>
00090
00100 C.DEX: DEFSYM <DAE,SAV,SHR,HGH,LOW,XPN,DMP>
00110 C.LDEX==.-C.DEX
00120
00130 S.DEX==C.DEX
00140 S.LDEX==C.LDEX
00150
00160 DEFINE TYPXMC(A)<
00170 XLIST
00180 ZZ==0
00190 IRP A,<
00200 IFL ZZ-T.EEND,<
00210 XWD SIXBIT \ A\,T.'A
00220 >
00230 ZZ==ZZ+1
00240 >
00250 LIST>
00260
00270 ;CALLED BY TYPXM MACRO - DEFINE DEFAULT INPUT EXTENSIONS
00280
00290 I.DEX: TYPXM
00300 I.LDEX==.-I.DEX
00310
00320 DEFINE TYPXMC(A)<
00330 XLIST
00340 ZZ==0
00350 IRP A,<
00360 IFE ZZ&1,<
00370 DEFINE X(B)<
00380 XWD FND'A,FND'B
00390 >>
00400 IFN ZZ&1,<
00410 X A
00420 >
00430 ZZ==ZZ+1
00440 >
00450 LIST>
00460
00470 TYPVEC: TYPXM
00010 DEFINE MODXMC(A)<
00020 XLIST
00030 ZZ==0
00040 IRP A,<
00050 IFE ZZ&1,<
00060 DEFINE X(B)<
00070 XWD MOD'A,MOD'B>>
00080
00090 IFN ZZ&1,<
00100 X A>
00110 ZZ==ZZ+1>
00120 LIST>
00130
00140 MODADR: MODXM
00150
00160 DEFINE MODXMC(A)<
00170 XLIST
00180 IRP A,<
00190
00200 IFE ^D36-YY*M.S,<
00210 EXP ZZ
00220 ZZ==0
00230 YY==0
00240 >
00250
00260 ZZ==<ZZ_M.S>+M.'A
00270 YY==YY+1
00280 >
00290 LIST>
00300
00310 ZZ==0
00320 YY==0
00330 MODLAL: MODXM
00340 MODXMC (END)
00350 ZZ==<ZZ_<^D36-YY*M.S>>
00360 EXP ZZ
00010 SUBTTL BYTE POINTERS
00020
00030 ;BYTE POINTERS
00040
00050 J.Y: POINT J.S,@JUSTAB
00060 M.Y: POINT M.S,@MODTAB
00070 W.Y: POINT W.S,@WIDTAB
00080 TIT.Y: POINT TIT.S,@TITTAB
00090 BYT.Y: POINT 36,@BYTTAB
00100 SUBT.Y: POINT SUBT.S,@SUBTAB
00110
00120 VRBPTR: IOWD VERBL,VERBN
00130 PDL: IOWD PDLEN,PDLIST
00140
00150 DEFINE FORMMC(A)<
00160 ZZ==0
00170 IRP A,<
00180 ZZ==ZZ!<1_<A-1>>>>
00190
00200 FORMMC <11,12,13,14,15>
00210
00220 FORMCH: EXP ZZ
00230
00240 ;LITERALS AND VARIABLES
00250
00260 XLIST
00270 LIT:: LIT
00280 LIST
00010 SUBTTL TABLE POINTERS
00020
00030 DEFINE TABLES<
00040 T SYM, ;SYMBOL TABLE
00050 T JUS, ;JUSTIFY KEYS
00060 T MOD, ;MODE KEYS
00070 T WID, ;WIDTH KEYS
00080 T TIT, ;TITLE LINE
00090 T SUB, ;SUBTITLE
00100 T OFF, ;OFFSET LIST
00110 T SYP, ;POINTERS FROM START OF S.T. TO
00120 ; A SPECIFIC PROGRAMS S.T.
00130 T SYN, ;NAMES OF PROGRAMS IN S.T.
00140 T SYV, ;LIST OF 1/2 WORD BYTES WHICH GIVE
00150 ; INDEX FROM START OF S.T. TO NEXT
00160 ; LARGER VALUE.
00170 T OPR, ;OPERATOR STACK
00180 T OPN, ;OPERAND STACK
00190 T BYT, ;BYTE TABLE
00200 >
00210
00220 DEFINE T(A)<
00230 SIXBIT /A'TAB/
00240 >
00250 TABNAM: TABLES
00010 RELOC
00020
00030 DEFINE T(A)<
00040 A'TAB: BLOCK 1
00050 A'NDX==.-TABVEC-1>
00060
00070 ZER:!
00080 TABVEC:!TABLES
00090 LSTTAB==.-TABVEC-1
00100
00110 DEFINE T(A) <
00120 A'LEN: BLOCK 1>
00130
00140 LENVEC:!TABLES
00010 SUBTTL DATA AND STORAGE LOCATIONS
00020
00030 ;BLOCK TO GET FILE SPECS FROM SCAN
00040
00050 F.ZER: PHASE 0
00060 %DEV:! BLOCK 1 ;DEVICE NAME IN SIXBIT
00070 %NAM:! BLOCK 1 ;FILE NAME IN SIXBIT
00080 %NAMM:! BLOCK 1 ;MASK WITH A 1 FOR EACH NON WILD BIT
00090 ; IN FILE NAME. NOT USED BY DUMP.
00100 %EXT:! BLOCK 1 ;EXTENSION IN LEFT HALF AND EXTENSION
00110 ; MASK IN RH
00120 %MOD:! BLOCK 1 ;SWITCH WORD
00130 %MODM:! BLOCK 1 ;MASK FOR SWITCH WORD
00140 %DIR:! BLOCK 2*LN.DRB ;PATH TO FILE. FIRST WORD IS PPN
00150 ; THEN PPN MASK. FOLLOWD BY SFD/SFD MASK
00160 ; PAIRS.
00170 F.LEN:! ;AMOUNT TO GET FROM SCANS F AREA
00180 FAREA:!
00190 %TYP:! BLOCK 1 ;TYPE OF FILE
00200 FAREAL==.-FAREA ;SIZE OF EXTERNAL F AREA
00210 DEPHASE
00220
00230 ;INPUT SPEC
00240
00250 I.ZER:!
00260 I.DEV: BLOCK 1
00270 I.NAM: BLOCK 1
00280 I.NAMM: BLOCK 1
00290 I.EXT: BLOCK 1
00300 I.MOD: BLOCK 1
00310 I.MODM: BLOCK 1
00320 I.DIR: BLOCK 2*LN.DRB
00330 I.TYP: BLOCK 1
00340
00350 ;COMPARISON FILE
00360
00370 C.ZER:!
00380 C.DEV: BLOCK 1
00390 C.NAM: BLOCK 1
00400 C.NAMM: BLOCK 1
00410 C.EXT: BLOCK 1
00420 C.MOD: BLOCK 1
00430 C.MODM: BLOCK 1
00440 C.DIR: BLOCK 2*LN.DRB
00450 C.TYP: BLOCK 1
00010 ;OUTPUT FILE
00020
00030 O.ZER:!
00040 O.DEV: BLOCK 1
00050 O.NAM: BLOCK 1
00060 O.NAMM: BLOCK 1
00070 O.EXT: BLOCK 1
00080 O.MOD: BLOCK 1
00090 O.MODM: BLOCK 1
00100 O.DIR: BLOCK 2*LN.DRB
00110 O.TYP: BLOCK 1
00120
00130 S.ZER:!
00140 S.DEV: BLOCK 1
00150 S.NAM: BLOCK 1
00160 S.NAMM: BLOCK 1
00170 S.EXT: BLOCK 1
00180 S.MOD: BLOCK 1
00190 S.MODM: BLOCK 1
00200 S.DIR: BLOCK 2*LN.DRB
00210 S.TYP: BLOCK 1
00220
00230
00240
00250 PAREA: BLOCK FAREAL
00010 ADRTMP: BLOCK 1 ;ADDRESS OF WORD IN INPUT FILE
00020 B.OC: BLOCK 3 ;BUFFER HEADER FOR OUTPUT FILE
00030
00040 ;THE NEXT 2 WORDS MUST GO TOGETHER
00050
00060 CATBLK: BLOCK 1 ;BEGINNING BLOCK OF CURRENT CATEGORY
00070 CATWRD: BLOCK 1 ;BEGINNING WORD OF CURRENT CATEGORY
00080
00090 CATLEN: BLOCK 1 ;LENGTH OF CURRENT CATEGORY
00100 CATNUM: BLOCK 1 ;CURRENT CATEGORY NUMBER
00110 CURCHR: BLOCK 1 ;CURRENT CHARACTER NUMBER ON LINE
00120 CURIOW: BLOCK 1 ;CURRENT IOWD FOR COMPRESSED FILES
00130 DAECCT: BLOCK 1 ;CURRENT CATEGORY
00140 DAECBK: BLOCK 1 ;CURRENT BLOCK IN DAEMON FILE
00150 DAECWD: BLOCK 1 ;CURRENT WORD IN BLOCK IN DAEMON FILE
00160 DMHEAD: BLOCK 1 ;AOBJN POINTER FOR DUMP MODE INPUT
00170 HGHOFF: BLOCK 1 ;OFFSET FOR HIGH SEGMENT
00180 INCADR: BLOCK 1 ;INCREMENT ADDRESS FOR DUMP
00190 INCPOS: BLOCK 1 ;INCREMENT POSITION
00200 INCSIZ: BLOCK 1 ;INCREMENT SIZE
00210 INPLST: BLOCK 2
00220 IRADIX: BLOCK 1 ;INPUT RADIX
00230 KEYPTR: BLOCK 1 ;POINTER TO LIST OF KEY WORDS FOR JUSTIFY OR MODES
00240 LINNUM: BLOCK 1 ;LINE NUMBER ON CURRENT PAGE
00250 LINPAG: BLOCK 1 ;LINES PER PAGE
00260 LMARGN: BLOCK 1 ;LEFT MARGIN
00270 LOWREL: BLOCK 1 ;LENGTH OF LOW SEGMENT FOR DAEMON CORE CATEGORY
00280 MAGWRD: BLOCK 1 ;MAGTAPE PARAMETERS
00290 OBUF: BLOCK 203
00300 ORADIX: BLOCK 1 ;OUTPUT RADIX
00310 OUTVAL: BLOCK 1 ;VALUE TO BE OUTPUT
00320 PAGLIM: BLOCK 1 ;PAGE LIMIT FOR OUTPUT
00330 PAGNUM: BLOCK 1 ;CURRENT PAGE NUMBER IF COUNTING
00340 PDLIST: BLOCK PDLEN ;PUSH DOWN LIST
00350 POSTMP: BLOCK 1 ;POSITION WORD
00360 RMARGN: BLOCK 1 ;RIGHT MARGIN
00370
00380 ;THE FOLLOWING BLOCK MUST STAY TOGETHER
00390
00400 SAVET1: BLOCK 1
00410 SAVET2: BLOCK 1
00420 SAVET3: BLOCK 1
00430 SAVET4: BLOCK 1
00440 SAVEP1: BLOCK 1
00450 SAVEP2: BLOCK 1
00460 SAVEF: BLOCK 1
00470 SAVEM: BLOCK 1
00480
00490 ;END BLOCK
00010 SAVADR: BLOCK 1 ;CURRENT ADDRESS FOR DUMP
00020 SAVPOS: BLOCK 1 ;CURRENT POSITION FOR DUMP
00030 SAVSIZ: BLOCK 1 ;CURRENT SIZE FOR DUMP
00040 SBLOCK: BLOCK 1 ;BLOCKS TO SKIP ON INPUT
00050 SFILES: BLOCK 1 ;FILES TO SKIP ON INPUT
00060 SIZTMP: BLOCK 1 ;SIZE WORD
00070 TEMPAD: BLOCK 1
00080 TRMADR: BLOCK 1 ;TERMINATING ADDRESS FOR DUMP
00090 TRMPOS: BLOCK 1 ;TERMINATING SIZE FOR DUMP
00100 WINADR: BLOCK 1 ;ADDRESS OF FIRST WORD IN WINDOW
00110 WINLEN: BLOCK 1
00120 WINLST: BLOCK 2
00130 JOBDAT: BLOCK 200 ;BUFFER FOR FIRST PART OF CORE IMAGE
00140 ;5 TEMPS USED TO FILL AND JUSTIFY OUTPUT (ROUTINE OUTPT:)
00150 PADCNT: BLOCK 1
00160 SAVCCH: BLOCK 1
00170 LPAD.Y: BLOCK 1
00180 WIDTMP: BLOCK 1
00190 JUSTMP: BLOCK 1
00200 LPAD: BLOCK 12 ;LIST OF 9-BIT BYTES USED TO REMEMBER HOW
00210 ; MANY BLANKS TO PREFIX A MESSAGE WITH SUCH
00220 ; THAT THE RESULT IS CENTERED OR RIGHT
00230 ; JUSTIFIED.
00240 S2VPTR: BLOCK 1 ;POINTER TO SYMBOL TABLE USED
00250 ; WHEN GOING FROM SYMBOL TO VALUE
00260 SYMPTR: BLOCK 1 ;TEMP USED BY SYMBOL TABLE LOGIC
00270 LASBIN: BLOCK 1 ;THE LAST ARGUMENT TO OP DECODER
00280 LASTOP: BLOCK 1 ;THE SYMBOL FOR THAT OPCODE
00290 OLDVAL: BLOCK 4 ;LAST ARGUMERT TO SYMBOL ENCODER
00300 OLDSYM: BLOCK 4 ;THE ANSWER FOR THAT VALUE
00310 SYMOFF: BLOCK 4 ;THE OFFSET FOR THAT VALUE
00320 SAVE4.: BLOCK 1 ;VALUE OF 1
00330 SAVE4$: BLOCK 1 ;VALUE OF $
00340 SAVEXP: BLOCK 1 ;VALUE OF %
00350 PATH: BLOCK 11 ;SFD PATH
00360
00370 EZER=.-1
00380
00390 WINDOW: BLOCK WINSIZ
00400
00410
00420 PATCH:
00430 PAT: BLOCK 20 ;FOR USE WITH DDT
00440 FRECOR::
00450 DMPEND: END DUMP