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