Trailing-Edge
-
PDP-10 Archives
-
BB-5255D-BM
-
4-sources/maklib.mac
There are 31 other files named maklib.mac in the archive. Click here to see a list.
TITLE MAKLIB - RELOCATABLE BINARY FILE MANIPULATION PROGRAM
SUBTTL I.L. GOVERMAN (VERSION 2A, PATCHING TOOL) 18-AUG-78
SUBTTL JANET EGAN (SCAN INTERFACE)/JIE 10-JAN-75
SUBTTL E. YOURDON (FUDGE2 PROGRAM)
;COPYRIGHT (C) 1975,1976,1977,1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
CUSTVR==0
DECVER==2
DECMVR==1
DECEDT==67
; VERSION NUMBER TO .JBVER
LOC 137
EXP <<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+<DECEDT>>
RELOC
;LOAD SYSTEM WIDE SYMBOLS FROM APPROPRIATE PLACES
SEARCH SCNMAC,UUOSYM,MACTEN
;LOAD MODULES THAT WE REQUIRE
.REQUEST REL:SCAN, REL:WILD, REL:HELPER
;DEFAULT TO TWO-SEGMENT CODE
ND PURESW,1
IFN PURESW,<TWOSEGMENTS
LOW: RELOC 400000>
;MAKE CLEAN LISTING, UNLESS SOME MACRO BLOWS UP
ND BIGLST,0
IFE BIGLST, <SALL>
IFN BIGLST, <LALL>
SUBTTL EDIT HISTORY FOR MAKLIB
;EDIT SPR DESCRIPTION
;---- --- -----------
;
;7 (NONE) PRESERVE T2 ACROSS CALL TO CORE UUO IN ALLOC ROUTINE
;10 (NONE) FIX ?FILE NOT FOUND MESSAGE
; ** END OF VERSION 1 **
;11 (NONE) ADD BINARY PATCHING TOOL
;12 (NONE) FIX HANDLING OF .TEXT ASCIZ
;13 (NONE) MAKE WILD CARDS WORK FOR TRANSACTION FILES
;14 (NONE) MAKE WILD CARDS WORK FOR MASTER ON /L,/T AND /P
;15 (NONE) ALLOW USE OF THE FULL RADIX50 CHARACTER SET
;16 (NONE) DONT INCREMENT 2ND WORD OF HISEG PRODUCED TYPE 3 BLOCK
;17 (NONE) MKLNIO (NO INDEX) MESSAGE GIVES WRONG FILENAME
;20 (19567) "?ILL UUO ..." WHEN DOING INSERT CORRECTED
;21 (35090) BYPASS SPACES BETWEEN COMMA AND INSERT KEYWORD
;22 (20391) CUSTOMER VERSION NUMBER OMITTED FROM .JBVER SETUP
;23 (35009) MAKE .DATE PSEUDO-OP A LITTLE MORE USEFUL
;24 (20355) MACPEK DOES NOT KNOW ABOUT LOWER CASE INPUT
;25 (35038) FIX FILE PROCESSOR DOES NOT KNOW ABOUT LINE NUMBERED FILES
;26 (20357) BAD ARITHMETIC IN .INSERT PROCESSOR FOR REPLACE KEYWORD
;27 (20156) FIX COMBINATIONS OF /NOLOCALS AND /INDEX
;30 (NONE) ADD .ALTER PSEUDO-OP
;31 (28328) INDEX BLOCK COUNT WRONG FOR 2ND AND SUBSEQUENT FILES INDEXED
;32 (NONE) MAKE MAKLIB ABLE TO ASSEMBLE WITH MACRO V52
;33 (NONE) ADD IFX TYPE CONDITIONALS
;34 (NONE) ADD .VERSION PSEUDO-OP TO SET UP .JBVER
;35 (NONE) DON'T FOLLOW GLOBAL REFERENCE CHAINS INTO ABSOLUTE CODE
;36 (NONE) FIX EDIT CONFLICT MESSAGE
;37 (NONE) ADD A WAY TO REMOVE SYMBOLS USING BPT
;40 (NONE) ADD /LOAD COMMAND TO TYPE OUT LOADING INSTRUCTIONS (REQ???&.TEXT)
;41 (20814) PERFORMANCE IMPROVEMENT IN WRDSRC AND SYMSRC
;42 (NONE) FURTHER IMPROVEMENT WITH CHANGE TO SYMSRC
;43 (20817) SLIGHT SPEEDUP IN OPSRC FOR HALF WORD VALUES
;44 (NONE) FIX TO COUNT FOR INDEX BLOCKS IN /TRACE AND /LOAD
;45 (20796) FILTER BLANKS OUT OF RADIX50 CORRECTLY IN READ11
;46 (NONE) DON'T PRE-ALLOCATE SYMBOL AND CODE AREA
;47 (20885) EXPAND SIZE OF "NUMBER OF INSTRS INSERTED" PART OF TRACE BLOCK
;50 (20884) EDIT 26 BROKE INSERTION AT START OF CORE-IMAGE
;51 (NONE) DONT USE XCOUNT IN READ, IT MUST BE PRESERVED
;52 (NONE) COUNT MUST RETURN 0 LENGTH FOR 0 HEADER, NOT 1
;53 (NONE) MAKE MAKLIB ABLE TO PATCH REL FILES ASSEMBLED WITH MACRO 52+
;54 (21346) INSURE PROPER MODE ON OPEN BY REPLACING MODE WORD
;55 (20628) HAVE FIX COMPILER DO THE IO INSTRUCTIONS (7XX) CORRECTLY
;56 (NONE) USE SCAN.REL RATHER THAN SCN7B.REL
;57 (NONE) DON'T GENERATE 0 WORDS FOR LITERAL LINES CONTAINING NO CODE
;60 (NONE) ADD AN IMPLEMENTATION OF 'BLOCK' OPERATOR TO FIX ASSEMBLER
;61 (NONE) HAVE '#' AFTER SYMBOL DEFINE A LOW SEG LOCATION LIKE MACRO
;62 (NONE) MAKE POLISH HANDLING CODE BETTER
;63 (21547) /MASTER ALONE WITH NO TRANSACTIONS FILE SHOULD BE ILLEGAL
;64 (21930) TEST CORRECT BITS FOR LAST BYTE=NULL
;65 DON'T ALLOW "*" TO BE USED AS OUTPUT FILE NAME.
;66 GIVE WARNING THAT TRANSACTION FILE IS IGNORED WITH /INDEX
;67 (25691) PREVENT ALLOCATION OF NEW BUFFER SPACE FOR EACH SWITCH.
;****** END OF REVISION HISTORY ********
SUBTTL DEFINE THE ACCUMULATORS
;MAKLIB ACCUMULATOR DEFINITIONS
F==0 ;FLAGS
T1==1 ;SCAN INTERFACE AC
T2==T1+1 ; "
T3==T2+1 ; "
T4==T3+1 ; "
R==5 ;SYMBOL NAME
T==6 ;HISTORICAL AC
N==7 ;NUMBER OR WORD FOR IO
CC==10 ;CHARACTER AC FOR INPUT
A==11 ;ARGUMENT AC, USED BY ROUTINES
B==12 ;..
C==13 ;..
D==14 ;..
IOC==15 ;IO CHANNEL FOR ACTIVE FILE
FPT==16 ;POINTER TO FILE AREA FOR CURRENT FILE
P==17 ;STACK POINTER
SUBTTL SCAN INTERFACE BIT DECLARATIONS
SW.APP==1B18 ;APPEND
SW.DEL==1B19 ;DELETE
SW.EXT==1B20 ;EXTRACT
SW.INS==1B21 ;INSERT
SW.MAS==1B22 ;MASTER
SW.REP==1B23 ;REPLACE
SW.FIX==1B24 ;FIX
SW.WHO==1B25 ;WHO
SW.LST==1B35 ;LIST
SW.NOL==1B34 ;DELETE LOCAL SYMBOLS
SW.POI==1B33 ;LIST ENTRY POINTS
SW.IND==1B32 ;INDEX
SW.TRC==1B31 ;TRACE
SW.LOA==1B30 ;LOAD
SW.EOT==1B29
SW.REW==1B28
SW.ZER==1B27
SUBTTL DECLARATION OF PARAMETERS
;INPUT-OUTPUT CHANNELS
SCNCHN==0 ;RESERVED FOR SCAN
OCHN==1 ;OUTPUT CHANNEL
MIN==2 ;MASTER FILE INPUT CHANNEL
TRIN==3 ;TRANSACTION FILE INPUT (ALSO USED FOR PATCH FILE)
; SYMBOL TABLE BITS THAT AGREE WITH THE DEFINITIONS THAT LINK USES
R5.DDT==400000,,0 ;SUPRESSED TO DDT
R5.REQ==600000,,0 ;GLOBAL REQUEST
R5.LCL==100000,,0 ;LOCAL SYMBOL
R5.GLB==040000,,0 ;GLOBAL DECLARATION
R5.FXA==1B0 ;GLOBAL FIXUP WORD 2,ADDITIVE FIXUP
R5.FXL==1B1 ; " " " ", TO LEFT HALF
R5.FXS==1B2 ; SYMBOL TABLE FIXUP
CBSIZE==^D20 ; NUMBER OF WORDS IN LINK CODE BLOCK (TYPE 1)
SBSIZE==^D20 ; NUMBER OF WORDS IN LINK SYMBOL BLOCK (TYPE 2)
; DEFINAEABLE PARAMETERS
ND MAXMOD,^D20 ;NUMBER OF ARGS MAXIMUM FOR SWITCHES
ND FSSIZE,<.FXLEN+1+MAXMOD> ;TOTAL SIZE OF SPEC AREA
.FXPRG==.FXLEN+1 ;OFFSET IN SPEC AREA TO PROGRAM NAMES
ND SIZE,200 ;SIZE OF ENTRY BLOCK THAT PROGRAM CAN HAVE
ND MTBSIZ,200 ;SIZE OF MASTER AND/OR TRANSACTION FILE BUFFER
ND TABS1,20 ;NUMBER OF TAB STOPS FOR NON-TTY DEVICE
ND TABS2,11 ;FOR TTY
ND FTBPT,1 ;DEFAULT TO INCLUDE BPT
IFE FTBPT,<DEBUG==0> ;NO DEBUGGING IF NO BPT
ND CREMAX,^D200 ;MAXIMUM NUMBER OF NEW SYMBOLS
CREMAX==<CREMAX+^D8>/^D9*^D9 ;ROUND UP TO NEXT LINK BLOCK
NSBMAX==CREMAX/^D9 ;NUMBER OF SYMBOL BLOCKS NEEDED
ND PATMAX,^D1000 ;MAXIMUM NUMBER OF NEW CODE WORDS
PATMAX==<PATMAX+^D16>/^D17*^D17 ;ROUND UP TO NEXT LINK BLOCK
NCBMAX==PATMAX/^D17 ;NUMBER OF CODE BLOCKS NEEDED
ND NPBMAX,1 ;MAXIMUM NUMBER OF NEW POLISH BLOCKS
ND TRCMAX,^D150 ;MAX. NUMBER OF TRACE WORDS AVAILABLE
ND ISTMAX,^D75 ;MAXIMUM NUMBER OF FORWARD REFERENCES OUTSTANDING
ND OPRSIZ,^D40 ;SIZE OF OPERAND STACK (4 WDS PER OPERAND)
ND OPTSIZ,^D10 ;SIZE OF OPERATOR STACK (1 WD PER OPERATOR)
ND MACSIZ,^D100 ;MAX. NR. OF MACRO CHARACTERS PER LINE
ND DEBUG,0 ;DEFAULT DEBUGGING STATUS
ND LI$TRC,1060 ;HEADER ID FOR TRACE BLOCK IN REL FILE
ND $EOL,12 ;CONVERT ALL BREAKS TO THIS
ND PD$LEN,^D150 ;DEFAULT PUSHDOWN LIST SIZE
SUBTTL FLAGS
; MACRO TO DEFINE FLAG BITS
DEFINE BIT($NAME)<
IFE $1BIT,<PRINTX ?TOO MANY FLAG BITS DEFINED>
$NAME==$1BIT
$1BIT==$1BIT*2
> ; END OF BIT DEFINITION
$1BIT==1 ;INIT
BIT(DEVTTY) ;ON MEANS OUTPUT DEVICE IS THE TTY
BIT(FOTTY) ;ON MEANS FORCE OUTPUT TO TTY
BIT(NOLOCB) ;ON MEANS DELETE LOCAL SYMBOLS
BIT(ERRB) ;ON MEANS PROGRAM ENTRY BLOCK TOO LARGE
BIT(IAE) ;ON MEAN BETWEEN .EDIT AND .ENDE
BIT(IAI) ;ON MEANS BETWEEN .INSERT AND .ENDI
BIT(F4IB) ;ON MEANS IGNORE F4 OUTPUT
BIT(XFLG) ;ON MEANS INDEX REQUESTED FOR FILE
BIT(DTAFLG) ;ON MEANS OUTPUT DEVICE IS DTA (SPECIAL INDEX)
BIT(NOWARN) ;ON MEANS DELETE "INDEX DELETED" MSG.
BIT(LSTENT) ;ON MEANS LIST ENTRY BLOCKS
BIT(FIXMOD) ;ON MEANS /FIX SWITCH WAS GIVEN
BIT(FSTMOD) ;ON MEANS [EDIT] SEEN SINCE LAST [MODULE]
BIT(CPASS2) ;ON MEANS WE'VE ALREADY REWOUND MASTER FILE
BIT(QUOTE) ;ON MEANS DONT EDIT CHARACTERS IN INPUT
BIT(REGET) ;ON MEANS GIVE LAST PATCH CHARACTER AGAIN
BIT(DEBMOD) ;ON MEANS IN DEBUGGING MODE
BIT(DEBIMC) ;ON MEANS DEBUGGING INTERNAL MACRO CODE
SUBTTL ERROR MESSAGE MACRO
; THESE MACROS INTERFACE WITH SCAN'S ERROR MESSAGE PROCESSOR.
; ALL BEHAVE ROUGHLY THE SAME. ALL USE T1-T4.
; $WARN IS USED TO PUT OUT A MESSAGE "%MKLXYZ TEXT"
; $TELL IS USED TO PUT OUT A MESSAGE OF THE FORM "[MKLXYZ TEXT]"
; $KILL IS USED TO PUT OUT A MESSAGE OF THE FORM "?MKLXYZ TEXT"
;
;
; ALL THREE MACROS TAKE UP TO FOUR ARGUMENTS;
;
; $PFX- THE UNIQUE 3 LETTER CODE FOR THIS ERROR. A LABEL IS CREATED
; OF THE FORM "E$$'$PFX"
;
; $TXT- THE REST OF THE MESSAGE TO BE TYPED OUT.
;
; $TYPO- A ROUTINE TO BE CALLED FOR TYPEOUT OF AC N. (OPTIONAL)
; IF PRESENT, IT IS PUSHJ P'ED TO AFTER THE TEXT IS TYPED.
;
; $CONT-IF THIS FIELD IS NON-BLANK, THEN MESSAGE CONTINUES. THE FINAL
; CALL TO .TCRLF SHOULD BE LABELED "X$$'$PFX"
; IF $CONT IS NON-BLANK AND NO LABEL X$$'$PFX EXISTS THEN
; ON SHORT ERROR STATUS CONTROL PASSES TO LABEL "DONERR"
; NOTE: ON A CONTINUED MESSAGE, FLAG BIT "FOTTY" IS STILL SET
; SO THAT AT THE LABEL "X$$'$PFX" AN INSTRUCTION LIKE
; TXZ F,FOTTY MUST BE PRESENT, UNLESS THE PROGRAM RESTARTS.
;
DEFINE $ERR($FLG,$PFX,$TXT,$TYPO,$CONT)<
IFB <$TXT>, <..TMP1==[EXP 0]>
IFNB <$TXT>, <..TMP1==[ASCIZ \$TXT\]>
..TMP2==0
..TMP3==0
IFNB <$TYPO>, <..TMP2==$TYPO>
IFNB <$CONT>,<
IF1,<..TMP3==-1>
IF2,< IFDEF X$$'$PFX,<..TMP3==X$$'$PFX>
IFNDEF X$$'$PFX,<..TMP3==DONERR>
>>
E$$'$PFX: JSP T1,$FLG
IFE BIGLST,<XLIST>
JUMP [XWD <''$PFX''>,..TMP1
XWD ..TMP2,..TMP3]
LIST
> ;END OF $ERR DEFINITION
; FATAL ERROR:
DEFINE $KILL($PFX,$TXT,$TYPO,$CONT)<
$ERR(E$KIL,$PFX,<$TXT>,$TYPO,$CONT)>
; WARNING:
DEFINE $WARN($PFX,$TXT,$TYPO,$CONT)<
$ERR(E$WRN,$PFX,<$TXT>,$TYPO,$CONT)>
; COMMENTARY:
DEFINE $TELL($PFX,$TXT,$TYPO,$CONT)<
$ERR(E$TEL,$PFX,<$TXT>,$TYPO,$CONT)>
; ROUTINES TO USE FOR TYPOUT OF AC N. NOTE THAT THESE ROUTINES ARE
; PUSHJ'ED TO AFTER AC T1 IS LOADED FROM AC N.
;
N$DEC==.TDECW## ;DECIMAL OUTPUT
N$OCT==.TOCTW## ;OCTAL
N$SIX==.TSIXN## ;SIXBIT
N$STRG==.TSTRG## ;STRING
N$50== PTYPO ;RADIX 50
N$CHR==.TCHAR## ;CHARACTER
N$PPN==.TPPNW## ;PPN
N$XWD==.TXWDW## ;XWD
IFN FTBPT,< N$EDIT==SAYED1> ;CURRENT EDIT NAME
SUBTTL INTERNAL FAILURE (STOPCODE) ERROR MACRO
; MAKLIB MAKES CHECKS ON ITS OWN BEHAVIOR AND REPORTS FAILURES
; AND INCONSITENCIES VIA THE $STPCD MACRO AND PROCESSOR.
DEFINE $STPCD($MSG)<
PUSHJ P,[MOVEI N,[ASCIZ \$MSG\]
PUSHJ P,STOPCD]
> ; END OF $STPCD MACRO
; MACROS AND PSEUDO-INTSTRUCTIONS USED BY BINARY PATCHING TOOL
;
IFN FTBPT,< ;DONT DEFINE IF BPT NOT INCLUDED
;MACRO TO GET FIRST NON-BLANK CHARACTER
DEFINE BYPASS<
PUSHJ P,MIC
XLIST
CAIN CC," "
JRST .-2
LIST >
;SOME COMMON INSTRUCTIONS
OPDEF SKPNUM [PUSHJ P,TDIGIT] ;SKIP IF CHARACTER IS NUMERIC
OPDEF SKPR50 [PUSHJ P,TR50] ;SKIP IF CHARACTER IS RADIX50
OPDEF SKPABC [PUSHJ P,TABC] ;SKIP IF CHARACTER IS ALPHABETIC
OPDEF SKPCM [CAIE CC,","] ;SKIP IF CHARACTER IS COMMA
OPDEF SKPNCM [CAIN CC,","] ;SKIP IF CHARACTER IS NOT COMMA
;SPECIAL CHARACTERS WHICH ARE HARD TO PUT IN-LINE
LABRKT=="<" ;LEFT ANGLE BRACKET
RABRKT==">" ;RIGHT ANGLE BRACKET
LSBRKT=="[" ;LEFT SQUARE BRACKET
RSBRKT=="]" ;RIGHT SQUARE BRACKET
SCOLON==";" ;SEMI COLON
LPAREN=="(" ;LEFT PAREN
RPAREN==")" ;RIGHT PARENTHESIS
SQUOTE=="'" ;SINGLE QUOTE
DQUOTE==42 ;DOUBLE QUOTE
> ; NFI FTBPT
COMMENT \
FORMAT OF TRACE BLOCK (LINK ITEM TYPE 1060)
THE LINK ITEM TYPE, "TRACE BLOCK DATA" IS USED TO INCLUDE IN
THE REL FILE INFORMATION THAT CAN BE USED TO BOTH VERIFY AND CHANGE
THE PATCH STATUS OF A PROGRAM. THE FORMAT OF THE TRACE BLOCK FOLLOWS:
THE FIRST PART OF THE TRACE BLOCK IS THE STATIC AREA. THIS AREA APPEARS
IN EACH MODULE THAT IS AFFECTED BY THE PARTICULAR EDIT. THE STATIC AREAS
GIVE INFORMATION COMMON TO ALL MODULES AFFECTED BY AN EDIT AND
THE VARIABLE AREA GIVES THE CHANGING DATA ON THE
PARTICULAR EDIT AS IT GOES FROM MODULE TO MODULE.
!=====================================!
TB$HED ! LINK ITEM NUMBER ! LENGTH OF BLOCK !
!-------------------------------------!
TB$EDT ! SIXBIT EDIT NAME (UP TO 6 CHRS) !
!-------------------------------------!
TB$STA ! -1 IF ACTIVE !WHO LAST AFFECTED !
!-------------------------------------!
TB$MAK ! WHO CREATED ! DATE (15 BIT) !
!-------------------------------------!
TB$INS ! WHO INSTALLED ! DATE (15 BIT) !
!-------------------------------------!
TB$FUT ! RESERVED FOR FUTURE USE !
!-------------------------------------!
TB$LEN ! # OF ASS. EDITS ! # OF PCO GROUPS !
!=====================================!
THE STATIC AREA, WHICH IS REPEATED IN EACH MODULE, IS FOLLOWED
BY A VARIABLE AREA. THE VARIABLE AREA CONSISTS OF TWO PARTS, THE
FIRST GIVING DATA ON THE ASSOCIATED EDIT STATUS FOR THIS MODULE AND
THE NEXT GIVING THE ACTUAL PROGRAM CHANGE ORDERS (PCO'S). THE
LENGTH OF EACH OF THESE AREAS APPEARS IN THE STATIC AREA OF THE TRACE
BLOCK.
FOR EACH ASSOCIATED EDIT, THE FOLLOWING GROUP APPEARS:
!=====================================!
TB$AEN ! SIXBIT EDIT NAME OF A.E. !
!-------------------------------------!
TB$AES !X! RESERVED FOR FUTURE ! X=0 IF MUST NOT BE PRESENT
!=====================================! =1 IF MUST BE PRESENT
AFTER THE ASSOCIATED EDIT GROUPS APPEAR, IF THERE ARE ANY, THE
PCO GROUPS FOR THAT MODULE APPEAR. THERE ARE CURRENTLY THREE TYPES
OF PCO GROUPS; INSERT,REMOVE AND RE-INSERT. THEY CAN
APPEAR IN ANY ORDER AND THE TOTAL NUMBER IS OF COURSE VARIABLE.
INSERT PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (1) ! LENGTH OF GROUP !
!-------------------------------------!
TB$DAT ! INSTRS INSRTD! ADDR. OF INSERT !
!-------------------------------------!
TB$PAT ! NEW ADDR OF ORG ! ADDR OF PAT CODE!
!=====================================!
REMOVE PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (2) ! LENGTH OF GROUP !
!-------------------------------------!
TB$REN ! SIXBIT EDIT NAME !
!=====================================!
RE-INSERT PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (3) ! LENGTH OF GROUP !
!-------------------------------------!
TB$RIN ! SIXBIT EDIT NAME !
!=====================================!
ALTER PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (4) ! LENGTH OF GROUP !
!-------------------------------------!
TB$DAT ! UNUSED ! ADDR. OF INSERT !
!-------------------------------------!
TB$PAT ! NEW ADDR OF ORG ! UNUSED !
!=====================================!
\
SUBTTL DEFINED MNEMONICS FOR THE TRACE BLOCK DATA
DEFINE TBDA($NAME)<
TB$'$NAME==$OFFSET
$OFFSET==TB$'$NAME+1
>
$OFFSET==0 ;INIT
TBDA(HED) ;HEADER
TBDA(EDT) ;EDIT NAME
TBDA(STA) ;STATUS
TBDA(MAK) ;MAKER
TBDA(INS) ;INSERTER
TBDA(FUT) ;RESERVED
TBDA(LEN) ;LENGTH OF AREA
TBDA(VAR) ;VARIABLE AREA
TB$SIZ==$OFFSET-2 ;SIZE OF BLOCK STATIC AREA COUNT
$OFFSET==0 ;RELATIVE ADDRESS
TBDA(AEN) ;ASSOCIATED EDIT NAME
TBDA(AES) ;ASSOCIATED EDIT STATUS REQUIRED
AESIZ==$OFFSET ;SIZE OF ASSOCIATED EDIT
$OFFSET==0 ;RELATIVE ADDRESS
;PCO TYPE 1, INSERT
TBDA(PCO) ;ALWAYS THERE
TBDA(DAT) ;INSERTION DATA
TBDA(PAT) ;NEW ADDR OF DISPLACED INSTR,,1ST INSTRUCTION OF PATCH
PCO1SZ==$OFFSET ;SIZE OF PCO TYPE 1 GROUP
$OFFSET==0 ;PCO TYPE 2,REMOVE
TBDA(PCO) ;SAME AS ABOVE
TBDA(REN) ;SIXBIT EDIT TO REMOVE
PCO2SZ==$OFFSET
$OFFSET==0 ;PCO TYPE 3,RE-INSERT
TBDA(PCO) ;
TBDA(RIN) ;RE-INSERT EDIT NAME
PCO3SZ==$OFFSET
$OFFSET==0
TBDA(PCO) ;PCO TYPE 4, ALTER
TBDA(DAT) ;INSERTION DATA
TBDA(PAT) ;PATCH AREA DATA
PCO4SZ==$OFFSET
PCOMAX==4 ;MAXIMUM DEFINED PCO NUMBER
SUBTTL INITIALIZE AND SETUP OF MAKLIB
MAKLIB: TDZA T1,T1 ; IN CASE OF CCL ENTRY
MOVEI T1,1 ;COMPUTE STARTING OFFSET
RESET ;RESET I/O DEVICES
MOVE [XWD LOW,LOW+1]
SETZM LOW
BLT LOWTOP-1
IFN PURESW,<
MOVE [XWD HIGH,LOW]
BLT LOWBLK>
MOVE P,[IOWD PD$LEN,PDLIST] ;SET UP PUSHDOWN POINTER
MOVEM T1,OFFSET ;STORE STARTING OFFSET
MOVE T1,[3,,[0
XWD OFFSET,'LIB' ;MY OFFSET AND CCL NAME
XWD 0,BOUT ] ;USE BOUT FOR TYPEOUT
]
TXO F,FOTTY ;FORCE ANY OUTPUT TO TTY
PUSHJ P,.ISCAN## ;INITIALIZE SCAN
MOVE T1,.JBFF## ;SAVE .JBFF
MOVEM T1,ORGFF ; FOR LATER
MOVEM P,ORGPP ;
SUBTTL MAKLIB COMMAND SCANNER
MAKSCN: MOVX F,FOTTY ;CLEAR FLAGS , FORCE OUTPUT TO TTY
MOVE P,ORGPP ;RESET PDL PHASE
RESET 0 ;CLEAR ALL I/O DEVICES
MOVE T1,ORGFF ;IF HAVE WE SWOLLEN
MOVEM T1,.JBFF## ;WE MUST REDUCE
IFE DEBUG,< ;DONT GET RID OF CORE IF DEBUGGING
SOS T1 ;OUR MINIMUM LEGAL SIZE
CORE T1, ;REDUCE OUR SIZE
JFCL ;WELL, WE TRIED
> ;EFI DEBUG
MOVE T1,[11,,[IOWD MKLSWL,MKLSWN
XWD MKLSWD,MKLSWM
XWD 0,MKLSWP
-1
XWD CLRANS,0
XWD ALLIN,ALLOUT
0
0
XWD 0,STORER ]]
PUSHJ P,.TSCAN## ;SCAN THE COMMAND LINE
MOVE T1,[5,,[IOWD MKLSWL,MKLSWN
XWD MKLSWD, MKLSWM
XWD 0 ,MKLSWP
-1
0]] ;SET TO FILL IN FROM SWITCH.INI
PUSHJ P,.OSCAN## ;FILL IN FROM THERE
PUSHJ P,CHECK ;SEE IF EVERYTHING IS THERE
SETZM WLDTMP ;CLEAR OUT TEMPORARY AREA FOR WILD
MOVE T1,OUTBEG ;TELL SCAN START OF OUTPUT SPEC
MOVEI T2,OPNBLK ; NAME OF OPEN BLOCK
MOVE T3,[.RBSIZ+1,,LKPBLK] ; LOOKUP BLOCK
HLRZM T3,LKPBLK
PUSHJ P,.STOPN## ;SCAN BLKS TO OPEN &LOOKUP BLKS
$KILL(WIO,Wild cards illegal for OUTPUT file specification)
TXZ F,FOTTY ;NO LONGER FORCE OUTPUT TO TTY
;ERROR MSG WILL SET THIS WHEN NEEDED
JRST SWTPRC ;NOW TO PROCESS THE SWITCHES
OPNFAI: TXO F,FOTTY
PUSHJ P,E.DFO##
JRST MAKSCN ;GO PROMPT AGAIN
LKPFAI: MOVEI T1,LKPBLK
MOVEI T2,6
MOVE T3,INBEG ;POINT TO INPUT SPEC
TXO F,FOTTY ;FORCE TO TTY
PUSHJ P,E.LKEN##
JRST MAKSCN
DM XXX,1,0,0
;;**[15] CHANGE SWTCHS DEFINITION TO USE INTERNAL PROCESSOR
DEFINE SWTCHS,<
SP *APPEND,SW.APP,SYMSW,XXX
SP *DELETE,SW.DEL,SYMSW,XXX
SP *EXTRAC,SW.EXT,SYMSW,XXX
SP *INSER,SW.INS,SYMSW,XXX
SP *MASTER,SW.MAS,SYMSW,XXX,FS.VRQ
SP *REPLAC,SW.REP,SYMSW,XXX
SP *FIX,SW.FIX,SYMSW,XXX
SP *WHO,SW.WHO,SYMSW,XXX,FS.VRQ
SS *LIST,<POINTR (SWIWRD,SW.LST)>,1,FS.NUE
SS *NOLOC,<POINTR (SWIWRD,SW.NOL)>,1,FS.NUE
SS *POINTS,<POINTR (SWIWRD,SW.POI)>,1,FS.NUE
SS INDEX,<POINTR (SWIWRD,SW.IND)>,1,FS.NUE
SS *TRACE,<POINTR (SWIWRD,SW.TRC)>,1,FS.NUE
SS LOAD ,<POINTR(SWIWRD,SW.LOA)>,1,FS.NUE
>
DOSCAN(MKLSW)
CLRANS: SETZM SCNBEG ;CLEAR ANSWER AREA
MOVE T1,[SCNBEG,,SCNBEG+1] ;STANDARD ZERO-AREA BLT
BLT T1,SCNEND ;CLEAR OUT CURRENT ANSWER
MOVE T1,ORGFF ;RESTORE
MOVEM T1,.JBFF## ; .JBFF
POPJ P,
ALLOUT: MOVE T1,.JBFF## ;POINT TO
MOVEM T1,OUTEND ; END OF OUTPUT AREA
SKIPN OUTBEG ;HAVE WE STARTED ALREADY?
MOVEM T1,OUTBEG ;NO--THIS IS THE BEGINNING
JRST ALLOC1
ALLIN: MOVE T1,.JBFF## ;POINT TO
MOVEM T1,INEND ; END OF INPUT AREA
SKIPN INBEG ; IF WE HAVEN'T STARTED YET
MOVEM T1,INBEG ; THIS IS THE BEGINNING
ALLOC1: MOVEM T1,A ;SAVE AWAY CURRENT FILE POINTER
MOVEI T2,FSSIZE-1(T1)
CAMG T2,.JBREL##
JRST ALLOC2
PUSH P,T2 ;PRESERVE T2, WE NEED IT
CORE T2, ;AND EXPAND CORE
JRST NECERR ;?NOT EVEN ENOUGH CORE FOR SWITCHES
POP P,T2 ;RESTORE ALLOCATION POINTER
ALLOC2: HRLI T1,TMAREA
BLT T1,(T2)
MOVE T1,A ;RESTORE CURRENT FILE POINTER
SETZM TMAREA+.FXLEN
MOVEI T2,FSSIZE
ADDM T2,.JBFF##
POPJ P,
STORER: TLZ T2,-1
TXNE T2,SW.WHO ;IS THIS /WHO?
JRST [ SKIPN WHO ;DONT OVERWRITE
HLRZM N,WHO ;ELSE STORE IT
POPJ P,] ;AND DONT CONFLICT
TRC T2,-1
TDNE T2,TMAREA+.FXLEN
$KILL(TMS,Too many switches)
TRC T2,-1
IORM T2,TMAREA+.FXLEN
JUMPE N,CPOPJ
HLRZ T2,TMAREA+.FXLEN
CAIL T2,MAXMOD
$KILL(TMN,Too many module names)
AOS T2
HRLM T2,TMAREA+.FXLEN
MOVEM N,TMAREA+.FXLEN(T2)
POPJ P,
; THIS ROUTINE INPUTS IN SIXBIT FORM 1 WORD WHICH CONTAINS
; A RADIX50 CHARACTER SET SYMBOL. THE ROUTINE CONFORMS
; TO SCAN STANDARDS AND UPDATES THE TERMINATOR.
;
SYMSW: PUSHJ P,.TICQT## ;ALLOW QUOTING
MOVEI N,0 ;START WITH NULL RESULT
MOVEI T1,.TSIXN## ;FOR ERROR MESSAGES
MOVEM T1,.LASWD## ;TELL SCAN WHAT TO DO
MOVE T1,[POINT 6,N] ;BYTE POINTER INITED
SYMS1: PUSHJ P,.TIAUC## ;GET A CHARACTER
PUSHJ P,.TIMUC## ;CONVERT TO UPPER CASE
SKIPLE .QUOTE## ;QUOTED?
JRST SYMS2 ;YES
PUSHJ P,TICSY ;IN RADIX50 SET?
JRST [ MOVEM N,.NMUL## ;NO,SO DEPOSIT INTO RESULT
POPJ P,] ;AND RETURN
SYMS2: CAIL CC,40 ;IN PROPER RANGE AT LEAST?
CAILE CC,137 ;
JRST E.ILSC## ;NO, "?ILLEGAL CHAR."
SUBI CC," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DISCARD PAST FIRST WORD
IDPB CC,T1 ;DEPOSIT IN INTERMEDIATE RESULT
JRST SYMS1 ;GO BACK FOR MORE
TICSY: CAIE CC,"%" ;ALLOW %.$
CAIN CC,"$" ;
JRST CPOPJ1 ;TAKE GOOD RETURN
PUSHJ P,.TICAN## ;IS IT ALPHANUMERIC
CAIN CC,"." ;NO, IS IT DOT?
AOS 0(P) ;YES,TAKE GOOD RETURN
POPJ P, ;RETURN IN EITHER CASE
CHECK: SKIPN T1,OUTBEG ;IS THERE AN OUTPUT SPEC?
$KILL(MCE,Command error)
SKIPN T2,INBEG ;POINT TO INPUT AREA
JRST E$$MCE
SKIPE .FXNAM(T1) ;IS THERE A FILENAME?
JRST CHECK1 ;YES--GOOD
SKIPN T3,.FXNAM(T2) ;[065] IF THERE'S A MASTER
$KILL(NEA,Not enough arguments specified)
MOVE T4,.FXDEV(T1) ;[065] GET OUTPUT DEVICE
DEVCHR T4, ;[065]
TXNE T4,DV.TTY ;[065] IS IT TTY: ?
JRST CHECK0 ;[065] YES, SO USE INPUT FILNAM FOR OUTPUT
CAMN T3,[120000,,0] ;[065] ELSE CHECK FOR "*"
$KILL(ANA,Asterisk not allowed as output file spec)
CHECK0: MOVEM T3,.FXNAM(T1) ;[065] USE NAME OF MASTER INSTEAD
SETOM T3,.FXNMM(T1) ;MASK IT 'CAUSE NOT WILD
CHECK1: SKIPE T3,.FXEXT(T1) ;IS THERE AN EXT SPECIFIED?
JRST CHECK2 ;EXT ALREADY THERE GO ON
MOVE C,.FXMOD(T1) ;CHECK MODIFIER WORD TO SEE
TXNN C,FX.NUL ; IF EXPLICITLY NULL EXT
JRST CHK1A
MOVE T4,SWIWRD ;GET THE SWITCHES
TXNE T4,SW.LST!SW.POI!SW.TRC!SW.LOA ;SOME SORT OF LISTING SPECIFIED?
JRST CHK1B ;IF YES LST IS DEFAULT
HRLOI T3,'REL' ;IF NONE--REL IS DEFAULT
CHK1A: MOVEM T3,.FXEXT(T1) ;SO FILL IT IN
JRST CHECK2
CHK1B: HRLOI T3,'LST'
MOVEM T3,.FXEXT(T1)
CHECK2: SKIPE T3,.FXLEN(T1) ;ANY SWITCH SEEN?
$KILL(SIO,Switches are illegal on output)
SKIPN T3,.FXNAM(T2) ;MASTER FILENAME THERE?
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
SKIPE T3,.FXEXT(T2) ;NO EXT SPECIFIED?
JRST CHECK4 ;EXT ALREADY THERE
MOVE C,.FXMOD(T2) ;CHECK MODIFIER WORD TO SEE
TXNE C,FX.NUL ;IF NULL EXT SPECIFIED
HRLOI T3,'REL' ;IF NONE .REL IS DEFAULT
MOVEM T3,.FXEXT(T2) ;SO FILL IN DEFAULT
CHECK4: MOVE T3,.FXLEN(T2) ;ANY SWITCH THERE?
JUMPE T3,CHECK6 ;NO SWITCH,SEE IF THAT'S OK
TXNE T3,SW.INS+SW.REP+SW.FIX ;INSERT OR REPLACE OR FIX?
$KILL(ISM,</INSERT,/REPLACE and /FIX are illegal switches on MASTER>)
TXNN T3,SW.MAS ;WAS THIS /MASTER?
JRST CHK4A ;NO,CONTINUE
CAMN T2,INEND ;YES,MUST HAVE A TRANSACTION FILE
JRST E$$NEA ;DONT, SO COMPLAIN
CHK4A: TXNN T3,SW.APP ;APPEND SPECIFIED?
JRST CHECKE ;NO-DON'T WORRY ABOUT IT
CAIE T3,400000 ;IF NO COUNT WE'RE O.K.
$WARN(EMA,Entire MASTER file will be appended)
JRST CHECKE ;AND CONTINUE
CHECK5: MOVE T3,.FXLEN(T2) ;POINT TO SWITCHES
JUMPE T3,CHECK6 ;NONE THERE
TXNE T3,SW.MAS ;MASTER?
$KILL(MTF,/MASTER switch cannot be used on TRANSACTION file)
TXNE T3,SW.FIX ;IS PATCHING WANTED?
TXO F,FIXMOD ;YES- MARK FIX MODE
SKIPE T3,.FXEXT(T2) ;IS AN EXT SPECIFIED?
JRST CHECKE ;EXT ALREADY THERE
MOVE C,.FXMOD(T2) ;SEE IF NULL EXT
TXNE C,FX.NUL ;ALREADY SPECIFIED
JRST [HRLOI T3,'REL' ;USE "REL" FOR DEFAULT
TXNE F,FIXMOD ;OR "FIX" IF WE ARE READING
HRLOI T3,'FIX' ;A PATCH FILE
JRST .+1]
MOVEM T3,.FXEXT(T2) ;SO FILL IT IN
JRST CHECKE ;AND FINISH UP
CHECK6: CAME T2,INBEG ;IS THIS THE MASTER FILE?
$KILL(CSR,Command switch is required)
CAME T2,INEND ;SEE IF ANY TRANS FILES
JRST CHECKE ;YES THEN CONTINUE
MOVE T1,SWIWRD ;GET SWITCHES
JUMPE T1,E$$CSR ;ERROR IF NONE
JRST CHECKE ;CONTINUE IF NO ERROR
CHECKE: ADDI T2,FSSIZE ;INCREMENT THE POINTER
CAMG T2,INEND ;RUN OUT OF ROOM OR TRANS FILES YET?
JRST CHECK5 ;MORE TRANS FILES
POPJ P,
SUBTTL COMMAND SWITCH PROCESSOR
SWTPRC: MOVE T2,SWIWRD ;GET SWITCH BITS
TXNE T2,SW.LST!SW.POI!SW.TRC!SW.LOA ;WANT LISTING?
JRST OLIST ;YES,GO DO IT
TXNN T2,SW.IND ;WANT INDEXING?
JRST NOLCHK ;NO--OTHER THINGS
MOVE T1,INBEG ;GET POINTER TO INPUT SPEC
SKIPE .FXLEN(T1) ;ANOTHER SWITCH THERE?
JRST E$$TMS ;INDEX MUST BE ALONE
CAME T1,INEND ;[66] IS THERE A TRANSACTION FILE
$WARN(TFI,TRANSACTION file ignored) ;[66] YES - ISSUE WARNING
PUSHJ P,INDOPN ;OPEN I/O STUFF
PUSHJ P,INDEX ;DO THE INDEXING
PUSHJ P,INDCLS ;FINISHED SO CLOSE
JRST MAKSCN ;AND BEGIN AGAIN
NOLCHK: TXNN T2,SW.NOL ;DELETE LOCAL SYMBOLS?
JRST SWTDIS ;NO--OTHER THINGS
MOVE T1,INBEG ;POINTER TO INPUT SPEC
SKIPE .FXLEN(T1) ;NOLOCALS MUST BE ALONE
JRST E$$TMS ;TELL HER TOO MANY SWITCHES
PUSHJ P,INDOPN ;OPEN BINARY OUTPUT
PUSHJ P,DELCPY ;GO DELETE AND COPY
JRST RSTRT ; BEGIN AGAIN
SUBTTL DO OUTPUT LISTINGS FOR /TRACE, /POINTS AND /LIST
OLIST: MOVE T1,INBEG ;GET POINTER TO INPPUT FILE
SKIPE .FXLEN(T1) ;IS THERE FILE-SPECIFIC SWITCH?
JRST E$$TMS ;YES,LEGAL ONLY FOR SWITCHES IN SWIWRD
TXZ F,LSTENT ;CLEAR LIST ENTRIES FLAG
TXNE T2,SW.POI ;LIST ENTRY POINTS?
TXO F,LSTENT ;SET FLAG TO LIST ENTRIES
MOVE T1,OUTBEG ;POINT TO THE OUTPUT SPEC
MOVE T1,.FXDEV(T1) ;PUT THE OUTPUT DEVICE IN T1
DEVCHR T1, ;DO A DEVCHR
TXNE T1,DV.TTY ;IS OUTPUT DEVICE A TTY?
TXO F,DEVTTY ;YES,REMEMBER THAT
PUSHJ P,OPNLKO ;OPEN OUTPUT FILE
MOVEI T1,[ASCIZ " Listing of "]
PUSHJ P,.TSTRG## ;GIVE SOME IDENTIFICATION
MOVE T2,SWIWRD ;GET SWITCHES
TXNE T2,SW.POI!SW.LST ;IF POINT OR LIST
JRST [ MOVEI T1,[ASCIZ "Modules"]
TXNE T2,SW.POI ;IF BOTH,SAY SO
MOVEI T1,[ASCIZ "Modules and Entry points"]
JRST OLIST0]
TXNE T2,SW.LOA ;IS IT A /LOAD LISTING?
SKIPA T1,[[ASCIZ "Internal loading instructions"]]
MOVEI T1,[ASCIZ "TRACE blocks"] ;NO, SO ASSUME /TRACE
OLIST0: PUSHJ P,.TSTRG## ;OUTPUT WHAT WE HAVE
PUSHJ P,.TCRLF## ;END LINE
MOVEI T1,[ASCIZ "Produced by MAKLIB Version "]
PUSHJ P,.TSTRG## ;
MOVE T1,.JBVER## ;GIVE VERSION NUMBER
PUSHJ P,.TVERW## ;FOR LISTING
MOVEI T1,[ASCIZ " on "] ;DATE TOO
PUSHJ P,.TSTRG## ;
PUSHJ P,.TDATN## ;OUTPUT DATE AND
MOVEI T1,[ASCIZ " at "] ;TIME TOO
PUSHJ P,.TSTRG##
PUSHJ P,.TTIMN## ;
PUSHJ P,.TCRLF## ;END WITH CRLF
OLIST1: PUSHJ P,LIOCLS ;OPEN NEXT MASTER FILE
JRST MAKSCN ;ALL DONE
MOVEI T1,[ASCIZ "
**************************
"]
PUSHJ P,.TSTRG## ;SEPARATE FILES
MOVEI T1,OPNBLK ;SET UP T1/ADDR OF OPEN BLOCK
MOVEI T2,LKPBLK ; " " T2/ADDR OF LOOKUP BLOCK
PUSHJ P,.TOLEB## ;TYPE THE DATA THERE
MOVEI T1,[ASCIZ " Created on "]
PUSHJ P,.TSTRG##
LDB T2,[POINT 3,.RBEXT+LKPBLK,20] ;GET HI-ORDER CREATION DATE
LDB T1,[POINT 12,.RBPRV+LKPBLK,35] ;AND LOW ORDER PART
DPB T2,[POINT 3,T1,23] ;MERGE THE TWO PARTS
PUSHJ P,.TDATE## ;AND PRINT IT
MOVEI T1,[ASCIZ " at "]
PUSHJ P,.TSTRG## ;ALSO GIVE THE TIME
LDB T1,[POINT 10,.RBPRV+LKPBLK,23] ;FROM THE LOOKUP BLOCK
IMULX T1,<^D60*^D1000> ;CONVERT TO MS FROM MINUTES
PUSHJ P,.TTIME## ;
PUSHJ P,.TCRLF## ;END WITH CRLF
PUSHJ P,.TCRLF##
MOVE T2,SWIWRD ;FETCH SWITCH WORD
TXNE T2,SW.TRC ;WANT TRACE?
JRST OLIST2 ;YES,GO DO IT
TXNE T2,SW.LOA ;WANT LOAD FILES?
JRST OLIST3 ;YES,GO DO THAT
PUSHJ P,LIST ;CALL LISTING ROUTINE
JRST OLIST1 ;GO BACK FOR NEXT FILE
OLIST2: PUSHJ P,TRACE ;DO THE TRACE
JRST OLIST1 ;AND GO BACK FOR NEXT FILE
OLIST3: PUSHJ P,TLOAD ;TYPE OUT ANY REQ??? BLOCKS
JRST OLIST1 ;THEN BACK FOR NEXT FILE OR END
SUBTTL FILE MANIPULATION ROUTINES FOR LISTING ROUTINES
OPNLKO: MOVX T1,.IOASC ;ASCII OUTPUT FOR LISTING
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVSI T1,OBUF ;CALCULATE BUFFER HEADER PTR
MOVEM T1,OPNBLK+.OPBUF ; FOR OPEN BLOCK
OPEN OCHN,OPNBLK ;OPEN OUTPUT FOR LISTING
JRST OPNFAI ;CANT DO IT
ENTER OCHN,LKPBLK ;NOW ENTER THE OUTPUT
JRST LKPFAI ;FAILURE
OUTBUF OCHN, ;OPEN OUTPUT BUFFERS
MOVE T1,.JBFF## ;REMEMBER WHERE OUTPUT BUFFER ENDS
MOVEM T1,LSTFF ;FOR MULTIPLE INPUT FILES
POPJ P, ;THEN RETURN
; LIOCLS IS CALLED AFTER EACH INPUT FILE IS PROCESSED (EOF SEEN)
; IT SKIPS AFTER NEXT FILE IS OPENED , OR NON-SKIPS IF ITS THE END,
; AFTER FINISHING UP BY CLOSING FILES.
LIOCLS: CLOSE MIN, ;CLOSE MASTER FILE
MOVE T1,LSTFF ;RECLAIM MASTER BUFFER SPACE
MOVEM T1,.JBFF## ;BY RESTORING FIRST-FREE
MOVE T1,[4,,[INBEG,,INEND ;POINTERS TO INPUT AREA
OPNBLK,,LKPBLK ;OPEN & LOOKUP BLOCKS
FSSIZE,,.RBSIZ+1;SIZE OF INSPEC&LKPBLK
WLDTMP+1B0]] ;ALL FOR LKWLD
PUSHJ P,.LKWLD## ;WILD LOOKS FOR MASTER FILE
JRST LSTEND ;END OF LISTINGS
MOVX T1,.IOBIN ;BINARY FOR MASTER INPUT
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVEI T1,MBUF ;MASTER FILE BUFFER
MOVEM T1,OPNBLK+.OPBUF
OPEN MIN,OPNBLK ;MASTER INPUT ON CHANNEL MIN
JRST OPNFAI ;CAN'T DO IT
LOOKUP MIN,LKPBLK ;DO THE LOOKUP
JRST LKPFAI ;CAN'T
INBUF MIN, ;SET UP THE BUFFER
JRST CPOPJ1 ;TAKE SKIP RETURN
LSTEND: CLOSE OCHN, ;DONE WITH THIS CHANNEL
STATZ OCHN,760000 ;CHECK FOR ERROR
JRST FSOERR ;ERROR
POPJ P, ;NEXT COMMAND
SUBTTL FILE MANIPULATION ROUTINES FOR INDEXING AND DELETING LOCAL SYMBOLS
INDOPN: MOVX T1,.IOBIN ; FOR TRANSACTION OUTPUT TOO
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVSI T1,OBUF ;OUTPUT BUFFER HEADER
MOVEM T1,OPNBLK+.OPBUF ;PUT POINTER IN THE OPEN BLOCK
OPEN OCHN,OPNBLK ;BINARY OUTPUT ON CH. OCHN
JRST OPNFAI
;CAN'T OPEN
ENTER OCHN,LKPBLK ;ENTER THE FILE
JRST LKPFAI ;CAN'T
MOVE T1,[4,,[INBEG,,INEND ;INFO FOR WILD
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD## ;WILD
POPJ P, ;THE END
SETZM NAMCTR ;CLEAR PROGRAM NAME COUNTER
MOVX T1,.IOBIN
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVEI T1,MBUF ;HEADER FOR MASTER FILE
MOVEM T1,OPNBLK+.OPBUF ;AND PUT IT IN THE OPEN BLOCK
OPEN MIN,OPNBLK ;OPEN
JRST OPNFAI ;CAN'T
LOOKUP MIN,LKPBLK ;LOOKUP
JRST LKPFAI ;CAN'T
INBUF MIN,
POPJ P,
INDCLS: CLOSE OCHN, ;DO LAST BLOCK
STATZ OCHN,760000 ;CHECK FOR ERROR
JRST FSOERR ;ERROR
CLOSE MIN, ;DONE WITH INPUT TOO
STATZ MIN,760000 ;CHECK FOR ERROR
JRST FSMERR
JRST MAKSCN
TRNCLS: CLOSE TRIN,
STATZ TRIN,760000
JRST FSTERR ;FILE STATUS ERROR FOR TRANSACTION
POPJ P,
SUBTTL DISPATCH FOR SWITCHES USING TRANSACTION FILES
SWTDIS: MOVE T1,OUTBEG ;GET OUTPUT SPEC
MOVE T1,.FXDEV(T1) ;WHAT DEVICE?
DEVCHR T1, ;MAKE SURE ITS LEGAL
TXNN T1,<DV.DSK!DV.DTA> ;MAKE SURE DISK OR DECTAPE
$KILL(ODD,Output device must be DISK or DECTAPE)
MOVX T1,.IOBIN ;BINARY OUTPUT
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVSI T1,OBUF ;BUFFER HEADER LOCATION
MOVEM T1,OPNBLK+.OPBUF ;AND PUT IT IN THE OPEN BLOCK
MOVE T2,[XWD OPNBLK,BCKBLK]
BLT T2,BCKBLK+<.RBSIZ+2+3>-1 ;SAVE OUTPUT SPECS
SETZM JBFSAV ;[67] TO HOLD .JBFF
MOVE T1,.JBFF## ;SAVE JOBFF FOR LATER THINGS
MOVEM T1,BCKFF ;SAVE FOR BACKING UP.
OPEN OCHN,OPNBLK
JRST OPNFAI
ENTER OCHN,LKPBLK
JRST LKPFAI
OUTBUF OCHN,
MOVE T1,INBEG ;GET INPUT
MOVE T1,.FXDEV(T1) ;GET MASTER DEVICE
DEVCHR T1,
TXNN T1,1B<^D35-.IOBIN> ;SEE IF BINARY AND DIRECT
$KILL(MCB,MASTER device must be capable of binary IO)
MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD##
$STPCD(Master file spec was missing)
SETZM NAMCTR ;CLEAR PROG NAME COUNTER
MOVX T1,.IOBIN
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVEI T1,MBUF ;GET BUFFER HEADER
MOVEM T1,OPNBLK+.OPBUF ; FOR THE OPEN BLOCK
OPEN MIN,OPNBLK
JRST OPNFAI
LOOKUP MIN,LKPBLK
JRST LKPFAI
INBUF MIN,
MOVE T1,WLDTMP ;SEE IF ANY TRANSACTION FILES
CAMN T1,INEND ;WERE SPECIFIED
JRST SWT2 ;NO,SO DONT OPEN ANY
SWT1: MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD##
JRST INDCLS
SETZM TNMCTR ;CLEAR TRANS PROG NAME COUNTER
MOVX T1,.IOBIN
TXNE F,FIXMOD ;IN PATCH MODE?
MOVX T1,.IOASC ;YES,SO WE WANT ASCII MODE
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVEI T1,TBUF ;GET BUFFEER HEADER POINTER
MOVEM T1,OPNBLK+.OPBUF ; FOR THE OPEN BLOCK
OPEN TRIN,OPNBLK
JRST OPNFAI
LOOKUP TRIN,LKPBLK
JRST LKPFAI
MOVE T1,.JBFF## ;[67] SAVE .JBFF
MOVEM T1,JBFSAV ;[67] SO BUFFERS DONT EXPAND FOREVER
INBUF TRIN,
SWT2: MOVE T3,WLDTMP
HRLZ T1,.FXLEN(T3)
JFFO T1,.+2
JRST E$$CSR ;ERROR IF NO SWITCH
CAILE T2,SWTBLL ;WITHIN RANGE OF TABLE?
$STPCD(Dispatch index out of range)
PUSHJ P,@SWTBL(T2) ;PROCESS THE SWITCH
JRST SWT3 ;[67] REMEMBER .JBFF
$STPCD(A COMMAND processor took the skip return)
SWT3: SKIPE T1,JBFSAV ;[67] DID WE DO INBUF ?
MOVEM T1,.JBFF## ;[67] YES - RESTORE .JBFF
JRST SWT1 ;[67] NO - CONTINUE
SWTBL: APPEND
DELETE
EXTRCT
INSERT
CPOPJ ;IN CASE /MASTER
REPLCE
FIXX
SWTBLL==.-SWTBL-1
SUBTTL MAKLIB COMMAND PROCESSORS
SUBTTL LIST & POINTS PROCESSOR
;LIST PROCESSOR
;THIS ROUTINE PROCESSES THE L COMMAND IN MAKLIB. BINARY
;PROGRAMS ARE READ, AND THEIR NAMES OUTPUT, UNTIL AN END
;OF FILE IS REACHED.
LIST: MOVE A,INBEG ;POINT TO INPUT AREA
MOVE T,.FXNAM(A) ;GET MASTER FILE NAME
SETOM END2 ;SIGNAL FIRST TIME THROUGH
PUSHJ P, MSTGET ;GET THE MASTER DEVICE
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
TXO F,NOWARN ;DON'T GIVE WARNING MESSAGE IF INDEX SEEN
LIST2: PUSHJ P, READ ;READ A PROGRAM NAME
JRST [TXNN F,LSTENT ;LISTED ENTRIES?
PUSHJ P,LIST5 ;NO, SO LIST RELOCATION
POPJ P,0 ] ;FINISHED
TXNE F,LSTENT ;LIST ENTRIES
JRST LIST4 ;YES, SO NO SIZE
SKIPL END2 ;BUT NOT FIRST TIME (NOT SET UP YET)
PUSHJ P,LIST5 ;LIST RELOCATION WORDS
LIST4: MOVE T1, A ;GET THE PROGRAM NAME IN B
PUSHJ P, PTYPO ;TYPE IT OUT
TXNE F,LSTENT ;ENTRY BLOCK AS WELL?
JRST LISTE ;YES
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LISTE: HRRZ C,ENTBLK ;GET NUMBER OF ENTRIES
JUMPE C,LIST3 ;NONE IN THIS PROGRAM
MOVNS C ;NEGATE
MOVSS C ;PUT IN LEFT HALF
HRRI C,ENTBLK+2 ;START OF ENTRIES
MOVEI D,TABS1 ;ASSUME NOT TTY
TXNE F,DEVTTY ;WAS IT?
MOVEI D,TABS2 ;TTY HAS SHORTER LINE
MOVEM D,TABCNT ;STASH IT
LISTE1: SKIPN T1,(C) ;GET AN ENTRY
AOJA C,.-1 ;IGNORE RELOCATION WORD
PUSHJ P,TYPTAB ;OUTPUT A TAB
PUSHJ P,PTYPO ;FOLLOWED BY SYMBOL
AOBJN C,LISTE1 ;FOR ALL OF BLOCK
LIST3: PUSHJ P, CRLF ;TYPE A CRLF
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LIST5: PUSH P,A ;SAVE NAME
MOVE B,END1 ;GET FIRST END WORD
TRNE B,-1 ;KLUDGE FOR FORTRAN
JRST LISTF ;YES, IT WAS
PUSHJ P,TYPTB1 ;ALWAYS LEAD WITH TAB
HLRZ T1,B ;OUTPUT OCTAL HALF WORD
PUSHJ P,OUTHW ;
SKIPN B,END2 ;IF SECOND WORD ZERO,
JRST LISTF ;DONT BOTHER TO LIST IT
PUSHJ P,TYPTB1 ;PRINT SECOND WORD
HLRZ T1,B
PUSHJ P,OUTHW
LISTF: PUSHJ P,CRLF ;TYPE CRLF AND RETURN
POP P,A ;RESTORE NAME
TXZ F,LSTENT ;CLEAR ENTRY POINT FLAG
POPJ P,
SUBTTL TRACE PROCESSOR
; /TRACE/ - THE COMMAND PROCESSOR TO TRACE THE PATCH BLOCKS
;
; THIS ROUTINE TRACES ALL EDIT/PATCH BLOCKS IN THE MASTER FILE.
;
TRACE: PUSHJ P,MSTGET ;SET UP INPUT IO CHANNEL
JRST E$$NEA ;IF ERROR RETURN
SETZM CURMOD ;START WITH NO KNOWN MODULE
TRC1: PUSHJ P,GETIN ;GET FIRST WORD
HLRZ B,A ;OF BLOCK AND EXAMINE HEADER
CAIN B,LI$TRC ;TRACE BLOCK?
JRST TRC5 ;YES,PROCESS IT
CAIN B,6 ;IS THIS THE PROGRAM NAME BLOCK?
JRST TRC3 ;YES, GO HANDLE IT
CAIE B,400 ;HANDLE F40 FUNNY TYPE
CAIN B,401 ;BLOCKS BY
JRST TRC3A ;CALLING SPECIAL ROUTINE
CAILE B,3777 ;NOT ASCIZ TEXT IS IT?
JRST TRC4 ;YES,DAMMIT
PUSHJ P,COUNT ;NO, SO COUNT WORDS IN BLOCK
TRC2: JUMPE B,TRC1 ;IF ZERO COUNT,IGNORE
PUSHJ P,GETIN ;DISCARD WORDS
SOJG B,.-1 ;TO CLEAR BLOCK
JRST TRC1 ;GET NEXT BLOCK
TRC3: PUSHJ P,COUNT ;COUNT SIZE OF NAME BLOCK
PUSHJ P,GETIN ;GET RELOC WORD
PUSHJ P,GETIN ;GET PROGRAM NAME
MOVEM A,CURMOD ;STORE PROGRAM NAME
SUBI B,2 ;ACCOUNT FOR TWO LOST WORDS
JRST TRC2 ;AND EAT ANY REMAINING PART OF BLOCK
TRC3A: TXO F,F4IB ;DON'T OUTPUT THE READ IN WORDS
PUSHJ P,F4 ;BECAUSE REL FILE IS READ ONLY
JRST TRC1 ;ON RETURN, GET NEXT HEADER
TRC4: ANDI A,177 ;DISCARD ALL BUT LAST BYTE
JUMPE A,TRC1 ;IF NULL BYTE, ITS OVER
PUSHJ P,GETIN ;GET A WORD
JRST TRC4 ;AND TRY AGAIN
TRC5: HRRZ D,A ;GET COUNT IN SAFER PLACE
PUSHJ P,.TCRLF##
MOVEI T1,[ASCIZ "Module: "]
PUSHJ P,.TSTRG## ;MODULE NAME
MOVE T1,CURMOD ;IS IN RAD50
PUSHJ P,PTYPO ;
SOJL D,E$$TBF ;ERROR IF NO WORDS LEFT
PUSHJ P,GETIN ;GET WORD 1
MOVEI T1,[ASCIZ " Edit: "]
PUSHJ P,.TSTRG##
MOVE T1,A ;GET EDIT NAME
PUSHJ P,.TSIXN## ;OUTPUT IN SIXBIT
MOVEI T1,[ASCIZ "
Status is "]
PUSHJ P,.TSTRG##
SOJL D,E$$TBF
PUSHJ P,GETIN ;GET WORD 2
MOVEI T1,[ASCIZ "Active"]
TLNN A,400000 ;SEE IF LH IS -1
MOVEI T1,[ASCIZ "Inactive"]
PUSHJ P,.TSTRG##
TRNN A,-1 ;IF RH IS BLANK,NO /WHO WAS USED
JRST TRC5A ;AND SO WE SKIP OUTPUTING IT
MOVEI T1,[ASCIZ "
Last affected by "]
PUSHJ P,.TSTRG##
HRLZ T1,A ;OUTPUT THE INITIALS
PUSHJ P,.TSIXN## ;IN SIXBIT
TRC5A: PUSHJ P,.TCRLF## ;END CURRENT LINE
SOJL D,E$$TBF ;NEG WORD COUNT INDICATES ERROR
PUSHJ P,GETIN ;READ WORD 3
JUMPE A,TRC5D ;ALL OPTIONAL INFO IN TB$MAK
MOVEI T1,[ASCIZ " Created"]
PUSHJ P,.TSTRG## ;CREATION DATA
TLNN A,-1 ;WERE INITIALS SPECIFIED?
JRST TRC5B ;NO,SO SKIP IT
MOVEI T1,[ASCIZ " By "] ;
PUSHJ P,.TSTRG## ;
HLLZ T1,A ;GET LH OF WORD 3,SIXBIT INITIALS
PUSHJ P,.TSIXN##
TRC5B: TRNN A,-1 ;DATE SPECIFIED?
JRST TRC5C ;NO SO SKIP IT
MOVEI T1,[ASCIZ " On "]
PUSHJ P,.TSTRG##
HRRZ T1,A ;GET 15 BIT DATE
PUSHJ P,.TDATE## ;AND PRINT IT
TRC5C: PUSHJ P,.TCRLF## ;END LINE
TRC5D: SOJL D,E$$TBF ;
PUSHJ P,GETIN ;GET WORD 4
JUMPE A,TRC5G ;IF BLANK
MOVEI T1,[ASCIZ " Installed"]
PUSHJ P,.TSTRG##
TLNN A,-1 ;SEE IF INSTALLERS INITIALS THERE
JRST TRC5E ;NO, THEY ARE NOT
MOVEI T1,[ASCIZ " By "]
PUSHJ P,.TSTRG##
HLLZ T1,A ;INSTALLERS INITIALS FROM /WHO
PUSHJ P,.TSIXN##
TRC5E: TRNN A,-1 ;SEE IF DATE THERE
JRST TRC5F ;NO,GO FINISH LINE
MOVEI T1,[ASCIZ " On "]
PUSHJ P,.TSTRG##
HRRZ T1,A ;GET 15 BIT 'DATE UUO' FORMAT DATE
PUSHJ P,.TDATE## ;USE SCAN OUTPUT ROUTINE
TRC5F: PUSHJ P,.TCRLF## ;END THE LINE
TRC5G: SOJL D,E$$TBF ;GET WORD 5 (CURRENTLY UNUSED)
PUSHJ P,GETIN ;
SOJL D,E$$TBF ;GET WORD 6
PUSHJ P,GETIN ;COUNT OF A.E.S AND PCOS
PUSH P,A ;SAVE THE COUNT
TLNN A,-1 ;ARE THERE ANY A.SSOCIATED E.DITS?
JRST TRC7 ;NO,GO PROCESS PCOS
HLRZ C,A ;COUNT OF PCOS
MOVEI T1,[ASCIZ " Associated edits:
"]
PUSHJ P,.TSTRG##
TRC6: SUBI D,AESIZ ;SUBTRACT SIZE OF ASSOCIATED EDIT
JUMPL D,E$$TBF ;NOT THERE THOUGH
PUSHJ P,TYPTB1 ;OUTPT THE TAB
PUSHJ P,GETIN ;GET FIRST WORD
PUSH P,A ;SAVE IT
PUSHJ P,GETIN ;GET SECOND WORD
MOVEI T1,[ASCIZ "Requires edit "]
TLNN A,(1B0) ;IF 1B0 IS ON,REQUIRED
MOVEI T1,[ASCIZ "Precludes edit "]; ELSE ITS PRECLUDED
PUSHJ P,.TSTRG## ;
POP P,T1 ;RESTORE EDIT NAME
PUSHJ P,.TSIXN##
PUSHJ P,.TCRLF## ;END LINE
SOJG C,TRC6 ;IF MORE ASSOCIATED EDITS
TRC7: POP P,A ;RESTORE THE COUNT
HRRZ C,A ;GET COUNT OF PCOS
JUMPE C,TRC8 ;IF NO CHANGE ORDERS
MOVEI T1,[ASCIZ " Program changes:
"]
PUSHJ P,.TSTRG##
TRC7A: SOJL D,E$$TBF ;IF NO WORDS LEFT
PUSHJ P,GETIN ;GET THE WORD
PUSHJ P,TYPTB1 ;START WITH TAB
HRRZ B,A ;GET LENGTH OF PCO GROUP
HLRZ T1,A ;GET PCO INDEX
CAILE T1,PCOMAX ;UNDER THE MAXIMUM?
JRST E$$TBF ;NO.
JRST @[ TRC71
TRC72
TRC73
TRC74 ]-1(T1) ;DISPATCH TO RIGHT PROCESS
TRC71: ;FOR PCO TYPE 1
SUBI D,2 ;MUST HAVE TWO WORDS LEFT
JUMPL D,E$$TBF
PUSHJ P,GETIN ;GET WORD
MOVEI T1,[ASCIZ "Inserts "]
PUSHJ P,.TSTRG## ;CODE INSERT
HLRZ T1,A ;GET NR. OF INSTRUCTIONS INSERTED
PUSHJ P,.TDECW## ;OUTPUT IT
MOVEI T1,[ASCIZ " instruction(s) at location "]
TRC71A: PUSHJ P,.TSTRG##
HRRZ T1,A ;GET THE ADDRESS
PUSHJ P,OUTHW ;AND OUTPUT IT
MOVEI T1,"'" ;FLAG AS RELOCATABLE
PUSHJ P,.TCHAR## ;IN CASE THEY LOOK
PUSHJ P,GETIN ;EAT THE NEXT WORD
JRST TRC7B ;AND THATS IT
TRC72: ;FOR PCO TYPE 2
MOVEI T1,[ASCIZ "Removes edit "]
TRC72A: PUSHJ P,.TSTRG##
SOJL D,E$$TBF ;INSURE PROPER COUNT
PUSHJ P,GETIN ;GET THE EDIT NAME
MOVE T1,A ;FOR OUTPUT
PUSHJ P,.TSIXN## ;OUTPUT IT
JRST TRC7B ;END OF PCOS 2 AND 3
TRC73: ;FOR PCO TYPE 3
MOVEI T1,[ASCIZ "Reinserts edit "]
JRST TRC72A ;CONTINUE AS PER PCO 2
TRC74: ;FOR PCO TYPE 4 (ALTER)
SUBI D,2 ;DATA BASE IS SAME AS FOR 1
JUMPL D,E$$TBF ;SO MAKE SAME CHECKS
PUSHJ P,GETIN ;GET FIRST WORD
MOVEI T1,[ASCIZ "Alters contents of location "]
JRST TRC71A ;SAVE SOME STEPS,FINISH AS FOR PCO 1
TRC7B: PUSHJ P,.TCRLF## ;END LINE
SOJG C,TRC7A ;IF MORE PCOS LEFT
TRC8: JUMPN D,E$$TBF ;SHOULD BE NO MORE WORDS LEFT
JRST TRC1 ;GET NEXT BLOCK
TRC9: POPJ P, ;RETURN TO COMMAND LEVEL
$WARN(TBF,TRACE block is badly formatted in module,,$MORE)
MOVE T1,CURMOD
PUSHJ P,PTYPO ;GIVE MODULE NAME
X$$TBF: PUSHJ P,.TCRLF## ;END WITH CR-LF
TXZ F,FOTTY ;NO MORE FORCED TO TTY
JRST TRC1 ;TRY TO CONTINUE
SUBTTL LOAD PROCESSOR FOR LISTING .TEXT ARGS AND .REQUIRE AND .REQUEST BLOCKS
; /TLOAD/ - THE COMMAND PROCESSOR TO TYPE THE .REQ??? BLOCKS IN A REL FILE
; ALONG WITH ALL .TEXT STRINGS
;
; THIS ROUTINE GIVES AN INDICATION OF WHAT FILES REQURE WHAT
; ALONG WITH SPECIAL INSTRUCTIONS THAT THE REL FILE GIVES TO LINK
TLOAD: PUSHJ P,MSTGET ;SET UP MASTER IO CHANNEL
JRST E$$NEA ;SHOULD BE ABLE TO
SETZM CURMOD ;START WITH NO MODULE KNOWN
TLD1: PUSHJ P,GETIN ;GET FIRST WORD OF BLOCK
HLRZ B,A ;GET TYPE CODE OUT
CAIN B,16 ;IS BLOCK TYPE FOR REQUIRE?
JRST TLD16 ;YES,GO DO IT
CAIN B,17 ;IS BLOCK TYPE FOR REQUEST?
JRST TLD17 ;YES,GO DO IT
CAIN B,6 ;IS THIS THE NAME BLOCK?
JRST TLD2A ;YES,PROCESS IT
CAIE B,400 ;MAKE CHECK FOR F40 CODE
CAIN B,401 ;SINCE IT IS HANDLED DIFFERENTLY
JRST TLD2B ;WE JUST GET TO END BLOCK
CAILE B,3777 ;MAKE CHECK FOR ASCIZ
JRST TLD3 ;IT IS,GO HANDLE IT
PUSHJ P,COUNT ;COUNT REMAINING WORDS
TLD2: JUMPE B,TLD1 ;IF NONE TO EAT,GET NEXT BLOCK
PUSHJ P,GETIN ;GET REST OF BLOCK
SOJG B,.-1
JRST TLD1 ;GET NEXT BLOCK
TLD2A: PUSHJ P,COUNT ;COUNT SIZE OF NAME BLOCK
PUSHJ P,GETIN ;GET RELOC WORD
PUSHJ P,GETIN ;GET PROGRAM NAME
MOVEM A,CURMOD ;STORE PROGRAM NAME
SUBI B,2 ;ADJUST BLOCK COUNT
JRST TLD2 ;AND FINISH BLOCK OFF
TLD2B: TXO F,F4IB ;IGNORE THE F40 INPUT
PUSHJ P,F4 ;EAT THE F40 CODE
JRST TLD1 ;AND THEN GET NEXT BLOCK
TLD3: SKIPE CURMOD ;IF NO MODULE HEADER LINE GIVEN YET,
PUSHJ P,TLDTMH ;GIVE IT NOW
MOVEI T1,[ASCIZ " Text string: "] ;TELL TYPE OF INSTRUCTION
PUSHJ P,.TSTRG## ;ASCIZ TEXT
TLD3A: MOVEI T1,A ;POINT TO ASCIZ WORD
SETZ B, ;CLEAR WORD AFTER TO MAKE IT ASCIZ
PUSHJ P,.TSTRG## ;OUTPUT THE WORD
ANDI A,177 ;GET DOWN TO LAST BYTE ONLY
JUMPE A,[ PUSHJ P,.TCRLF## ;IF OVER WITH .TEXT, BIND OF W/CRLF
JRST TLD1 ] ;AND GET NEXT BLOCK
PUSHJ P,GETIN ;ELSE GET NEXT WORD OF STRING
JRST TLD3A ;AND REPEAT TYPE-OUT LOOP
TLD16: SKIPA C,[[ASCIZ " Requires "]]; FOR REQUEST LOAD (REQUIRE)
TLD17: MOVEI C,[ASCIZ " Requests "] ; FOR REQUIRED LIBRARY (REQUEST) FILES
SKIPE CURMOD ;TYPED OUT MODULE HEADER ALREADY?
PUSHJ P,TLDTMH ;NO,TYPE IT OUT
PUSHJ P,COUNT ;COUNT WORDS IN BLOCK
PUSHJ P,GETIN ;EAT RELOCATION WORD
SUBI B,1 ;BACK OFF ONE FOR RELOCATION
TLD4: JUMPLE B,TLD1 ;GET THE NEXT BLOCK WHEN DONE
CAIGE B,3 ;MUST HAVE TRIPLET FOR REQ??? BLOCK
JRST E$$RBF
MOVE T1,C ;GET APPROPRIATE MESSAGE
PUSHJ P,.TSTRG## ;AND PRINT IT
PUSHJ P,GETIN ;GET FIRST WORD (FILENAME)
PUSH P,A ;STASH FOR NOW
PUSHJ P,GETIN ;GET 2ND WORD (UFD NAME)
EXCH A,0(P) ;MAKE REVERSE ORDER
PUSH P,A ;STASH FOR NOW
PUSHJ P,GETIN ;GET SIXBIT DEVICE NAME
JUMPE A,TLD5 ;IF NULL,DONT PRINT IT
MOVE T1,A ;GET IN PROPER PLACE
PUSHJ P,.TSIXN## ;OUTPUT DEVICE NAME
MOVEI T1,":" ;STANDARD SEQUENCE
PUSHJ P,.TCHAR## ;OUTPUT IT AS "DEV:"
TLD5: POP P,T1 ;GET FILE NAME
PUSHJ P,.TSIXN## ;PRINT IT OUT
POP P,T1 ;GET UFD NAME
JUMPE T1,TLD6 ;IF NULL, DONT PRINT UFD
PUSHJ P,.TPPNW## ;ELSE PRINT IT OUT VIA SCAN
TLD6: PUSHJ P,.TCRLF## ;AND END LINE
SUBI B,3 ;USED THREE WORDS FROM INPUT FILE
JRST TLD4 ;SEE IF MORE IN SAME BLOCK
TLDTMH: PUSHJ P,.TCRLF## ;NEW MODULE ON NEW LINE
MOVEI T1,[ASCIZ "Module: "]
PUSHJ P,.TSTRG## ;
SETZ T1, ;START WITH ZERO FOR DEPOSIT
EXCH T1,CURMOD ;SO WE ONLY DO THIS ONCE
PUSHJ P,PTYPO ;OUTPUT RADIX50 MODULE NAME
PJRST .TCRLF## ;RETURN WITH NEW LINE SET UP
$KILL(RBF,REQUEST or REQUIRE block is badly formatted)
SUBTTL REPLACE PROCESSOR
;THIS ROUTINE PROCESSES THE R COMMAND IN MAKLIB. THE TOTAL
;COMMAND STRING IS BROKEN INTO A LIST OF PROGRAMS FOR THE MASTER
;DEVICE, AND A LIST OF PROGRAMS FOR THE TRANSACTION DEVICES.
;THE ROUTINE READS THE MASTER FILE UNTIL ONE OF THE DESIRED
;REPLACEMENT PROGRAMS IS REACHED, THEN SWITCHES TO THE
;TRANSACTION DEVICE TO FIND THE PROGRAM WHICH IS TO REPLACE THE
;PROGRAM IN THE MASTER FILE. AFTER THE REPLACEMENT HAS BEEN
;EFFECTED, RESET IS CALLED TO RESTORE THE MASTER DEVICE TO ITS
;OLD POSITION.
REPLCE: PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST [PUSHJ P,COPY ;NO MORE, COPY REST OF MASTER
JRST INDCLS] ;
PUSHJ P, COPYTO ;COPY UP TO THE PROGRAM NAME
PUSHJ P, TRNGET ;GET A PROGRAM FROM TRANSACTION
$KILL(NTM,Not enough TRANSACTION modules were specified)
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST REPLCE ;LOOK FOR MORE REPLACEMENTS
SUBTTL INSERT PROCESSOR
;THIS SUBROUTINE PROCESSES THE I COMMAND IN FUDGE. IT READS AND
;WRITES PROGRAMS FROM THE MASTER FILE UNTIL IT FINDS THE
;PROGRAM NAME CURRENTLY POINTED TO, AT WHICH TIME IT STARTS READING
;FROM THE TRANSACTION DEVICE, MAKING AN INSERTION AT THE
;PROPER PLACE.
INSERT: PUSHJ P, MSTGET ;GET FIRST PROGRAM FROM MASTER FILE
$KILL(IRM,/INSERT requires at least one /MASTER specification)
INSER1: MOVEM R,NAMSAV ;COPY NAME TO SAFE PLACE
PUSHJ P, COPYTO ;COPY UP TO A PROGRAM NAME
MOVEM C, SAVEAC ;SAVE SPECIAL ACCUMULATOR
MOVE D, [XWD ENTBLK,SVEBLK]
BLT D,SVEBLK-ENTBLK(C) ;[20]MOVE ENTRY BLOCK TO SAVE BLOCK
INSER2: PUSHJ P, TRNGET ;GET NEXT TRANSACTION FILE
JRST E$$NTM ;FATAL - NOT ENOUGH TRANSACTION MODS
PUSHJ P, FINDCP ;FIND TRANSACTION FILE AND COPY
PUSHJ P,MSTGET ;GET NEXT MASTER FILE
JRST [PUSHJ P,FIXUP ;COPY OUT THE LAST MASTER PROG
PUSHJ P,COPY ;COPY THE REST OF THE FILE
JRST INDCLS] ;FINISH UP
CAMN R,NAMSAV ;THIS MODULE SAME AS LAST
JRST INSER2 ;YES,NO NEED TO TOUCH MASTER
PUSHJ P,FIXUP ;DIFFERS SO WRITE OUT CURRENT MASTER PRG.
JRST INSER1 ;AND GET NEXT
FIXUP: MOVE C, SAVEAC ;RESTORE SPECIAL AC
MOVS D, [XWD ENTBLK,SVEBLK]
BLT D, (C) ;RESTORE ENTRY BLOCK
MOVEI IOC,MIN ;SET UP CHANNEL AC
MOVEI T,MBUF+1 ;COUNT
MOVEM T,IBUF1 ;SET UP
AOS T
MOVEM T,IBUF2 ;DONE
MOVE FPT,INBEG ;
PUSHJ P, WRITE ;WRITE OUT THE CURRENT FILE
POPJ P, ;RETURN TO CALLER
SUBTTL EXTRACT & DELETE PROCESSORS
;THIS ROUTINE PROCESSES THE E COMMAND IN FUDGE. RATHER THAN
;ONE MASTER AND SEVERAL TRANSACTION FILES, ALL FILES ARE
;TREATED THE SAME. AFTER A CALL TO EITHER MSTGET OR TRNGET
;PROGRAMS ARE SEARCHED FOR AND WRITTEN ON THE OUTPUT DEVICE.
EXTRCT: TXO F,NOWARN ;NO WARNING MESSAGE
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST EPROC1 ;ALL DONE WITH MASTER DEVICE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? **VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC1 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EXTRCT ;RETURN FOR MORE MASTER PROGRAMS
EPROC1: PUSHJ P, TRNGET ;GET PROGRAM FROM TRANS FILES
POPJ P, ;ALL DONE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? ***VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC1 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EPROC1 ;RETURN FOR MORE TRANS FILES
SUBTTL DELETE PROCESSOR
;THIS ROUTINE PROCESSES THE DELETE COMMAND IN MAKLIB.
; NOTE: ONLY ONE INPUT FILE WILL BE READ, AND THE PROGRAM NAMES ASSOCIATED
;WITH ITS LIST WILL BE DELETED.
DELETE: MOVEI T1,INDCLS ; RESET RETURN ADDRESS
HRRM T1,(P) ;BECAUSE DELETE IS ONE TIME ONLY
DELET1: PUSHJ P,MSTGET ; GET A PROGRAM FROM MASTER FILE
JRST DELET3 ; NO MORE SPECIFIED-FINISH OFF MASTER
PUSHJ P,RAD50 ;CONVERT R TO RADIX 50
DELET2: PUSHJ P,READ ; READ A PROGRAM
JRST MNFERR ; EOF - PROGRAM NOT IN FILE
CAMN R,A ; IS THIS THE RIGHT PROGRAM
JRST DELET1 ; YES - DELETE IT AND CONTINUE
PUSHJ P,WRITE ; NO - COPY THIS ONE
JRST DELET2 ; AND CONTINUE LOOKING
DELET3: PUSHJ P,COPY ; COPY OUT REST OF MASTER FILE
POPJ P, ; AND GO HOME
SUBTTL APPEND PROCESSOR
;THIS ROUTINE HANDLES THE APPEND COMMAND IN MAKLIB.
;IT WILL COPY THE ENTIRE MASTER FILE, THEN START OBTAINING TRANSACTION
;FILES WITH CALLS TO TRNGET, APPENDING ONE OR MORE
;PROGRAMS FROM EACH FILE.
APPEND: PUSHJ P,MSTGET ;GET A PROGRAM FROM MASTER FILE
$STPCD(APPEND can't find MASTER specifications)
;FATAL SINCE WE JUST WANT TO SET UP
PUSHJ P,COPY ;COPY ENTIRE MASTER
APPND1: PUSHJ P,TRNGET ;GET A PROGRAM NAME FROM TRANSACTION
POPJ P, ;NO MORE PROG NAMES IN THIS FILE
PUSHJ P,FINDCP ;FIND PROGRAM AND COPY IT
JUMPE R,CPOPJ ;ZERO NAME DON'T LOOP
JRST APPND1 ;LOOP FOR MORE PROGRAMS
SUBTTL INDEX AND DELETE LOCAL SYMBOLS PROCESSOR
;THESE ROUTINES PROCESS THE /INDEX COMMAND AND THE /NOLOCALS COMMAND.
; THEY GIVE COMBINATIONS OF INDEXED FILES WITH AND WITHOUT LOCALS
; AND CAN ALSO JUST DELETE LOCAL SYMBOLS.
INDEX: MOVE A,OUTBEG ;GET OUTPUT DEVICE
MOVE A,.FXDEV(A)
DEVCHR A, ;GET ITS CHARACTERISTICS
TXNN A,DV.DSK!DV.DTA ;ONLY ALLOW DSK AND DTA
JRST E$$ODD ;GIVE ERROR MESSAGE
;**[27] INDEX+6 ILG 12-JUL-76
TXO F,NOWARN!XFLG ;[27]NO LOST INDEX WARNING, INDEX NOW
MOVE T1,SWIWRD ;[27]FETCH SWITCH WORD
TXNE T1,SW.NOL ;[27]/NOLOCALS SPECIFIED?
;ENTRY POINT FOR /NOLOCALS W/OUT /INDEX
DELCPY: TXO F, NOLOCB ;SET FLAG TO DELETE LOCAL SYMBOLS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER FILE
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
;**[27] DELCPY+3 ILG 12-JUL-76
TXNE F,XFLG ;[27]IF DOING INDEXING
PUSHJ P,INDEX0 ;SET UP POINTERS FOR INDEXING
PUSHJ P, COPY ;COPY ENTIRE FILE
TXNN F,XFLG ;INDEX FLAG ON?
JRST RSTRT ;ALL DONE
JRST INDEX3 ;YES DO PASS 2
SUBTTL DUMMY "FIX" PROCESSOR TO HANDLE COMMAND IF NOT ASSEMBLED
IFE FTBPT,<
FIXX: $KILL(BNI,Binary patching tool not included in MAKLIB)
> ;EFI FTBPT
SUBTTL FIX PROCESSOR (STARTS LONG 'IFN FTBPT' CONDITIONAL)
IFN FTBPT,<
FIXX: MOVEM P,FIXXP ;SAVE P, EOF CAN COME FROM ANYWHERE
MOVE FPT,WLDTMP ;GET ADDRESS OF TRANS FILE STUFF
HLRZ T1,.FXLEN(FPT) ;ANY ARGS SPECIFIED?
SKIPE T1 ;IF 0, ITS OK
$WARN(AFI,Arguments to /FIX switch are ignored)
MOVE FPT,INBEG ;SEE IF /MASTER SPECIFIED
HLRZ FPT,.FXLEN(FPT) ;BECAUSE WE IGNORE IT
SKIPE FPT ;IF 0, WAS NOT SPECIFIED
$WARN (MNI,/MASTER module names are ignored when patching)
SETZM CURMOD ;CLEAR CURRENT MODULE NAME
SETZM LLABEL ;CLEAR LAST LABEL SEEN
SETZM NSTLVL ;CLEAR CURRENT NESTING OF <>
TXZ F,IAE!IAI ;NOT IN EDIT OR INSERT
SETZM PRGINC ;NO PROGRAM IN CORE RIGHT NOW
MOVEI T1,TRCBLK ;SET UP AREA FOR TRACE BLOCK
MOVEM T1,TRCVAP ;
PUSHJ P,ISTINI ;INITIALIZE THE IST
MOVEI T1,^D8 ;INITIAL RADIX IS RADIX 8.(10)
MOVEM T1,CRADIX ;DONE
FIXLL: PUSHJ P,ISTSAV ;SAVE IST ACROSS IN CASE OF ERROR
PUSHJ P,EVAL ;EVALUATE CODE
IFN DEBUG,<
TXNE F,DEBMOD ;IN DEBUGGING MODE?
JRST [PUSHJ P,LSTCOD ;YES,JUST LIST CODE
PUSHJ P,ISTRST ;RESTORE IST POINTERS
JRST FIXLL ] ;AND GET MORE
> ; NFI DEBUG
TXNN F,IAI ;RETURNED WITH CODE,INSIDE INSERT?
JRST FIX9 ;NO, SO COMPLAIN
MOVE C,R%V ;VALUE RETURNED
MOVE B,R%R ;RELOCATION
TLNE B,1 ;LH RELOCATED TOO?
TRO B,<1B34> ;YES,INDICATE THAT
TLZ B,-1 ;AND CLEAR LEFT HALF
PUSHJ P,NEWCODE ;INSERT CODE
JRST INSERR ;TOO LITTLE ROOM
PUSHJ P,PMEXT ;FIXUP ANY EXTERNALS
PUSHJ P,PMMWS ;FIXUP ANY MULTI-WORD STRINGS
AOS CPINST ;ONE MORE INSTRUCTION INSERTED
SKIPN BARFLG ;IF REPLACING,
AOS CPRET ;UPDATE RETURN
JRST FIXLL ;BACK FOR MORE CODE
FIX1: TXNE F,IAE ;WERE WE BETWEEN EDITS?
JRST PEFERR ;NO,SO EOF WAS PREMATURE
PUSHJ P,PUTPG ;PUSH OUT PROGRAM IN CORE (IF ANY)
PUSHJ P,MSTGET ;RESET INPUT IO TO MASTER
JFCL ;DONT CARE IF NO FILE NAMES
PUSHJ P,COPY ;COPY OUT THE REST OF FILE
MOVE P,FIXXP ;RESTORE PUSHDOWN LIST POINTER
POPJ P, ;AND RETURN
FIX9: $WARN(CII,Code generated outside of range of .INSERT was ignored:,,$MORE)
PUSHJ P,.TCRLF##
PUSHJ P,TYPTB1
MOVEI T1,MACBUF
PUSHJ P,.TSTRG##
SKIPA
X$$CII: PUSHJ P,.TCRLF##
TXZ F,FOTTY
PUSHJ P,ISTRST ;RESTORE IST TO STATE BEFORE CALL
JRST FIXLL ;BACK FOR NEXT LINE
; NOTE WELL: *******
; STILL UNDER IFN FTBPT WHICH CONTINUES FOR QUITE A FEW PAGES
;
SUBTTL YANKPG- ROUTINE TO YANK ONE PROGRAM INTO CORE
;THIS ROUTINE LOADS THE PROGRAM INTO CORE, SETTING UP POINTERS TO
;VARIOUS AREAS OF INTEREST IN THE FILE. NOTE THAT THE ENTRY AND
;NAME BLOCKS HAVE ALREADY BEEN PLACED IN ENTBLK.
YANKPG: MOVEM C,SAVEAC ;SAVE C, IT GIVES END OF ENTBLK
SETZM FMZLOC ;CLEAR FIRST MODULE ZERO
MOVE C,[XWD FMZLOC,FMZLOC+1] ;AND CLEAR REST OF AREA
BLT C,LMZLOC ;CLEAR TO LAST
MOVE C,.JBFF## ;GET END OF CORE USED
MOVEM C,PSLOC ;SAVE START OF PROGRAM
SOS C ;BACK OFF ONE SO DEPWRD CAN INCREMENT
YANK1: PUSHJ P,GETIN ;GET A WORD OF REL FILE
PUSHJ P,DEPWRD ;DEPOSIT INTO CORE
HLRZ B,A ;GET BLOCK TYPE
CAILE B,3777 ;IS IT ASCIZ .TEXT?
JRST YANK3 ;YES,HANDLE IT DIFFERENTLY
MOVSI T,-BLKLEN ;GET READY TO LOOK IT UP
YANK2: CAMN B,BLKCOD(T) ;A CODE
JRST @YTABLE(T) ;MATCHES!
AOBJN T,YANK2 ;NO MATCH,TRY AGAIN
CAIG B,37 ;IN RANGE 0-37?
JRST YANK2A ;YES,SO ITS LEGAL OLD TYPE
CAIL B,1000 ;CHECK RANGE 1000-1777 FOR
CAILE B,1777 ;NEW TYPE LINK ITEMS
JRST IBTERR ;NOT A RECOGNIZED BLOCK TYPE
YANK2A: PUSHJ P,COUNT ;COUNT WORDS THAT FOLLOW
YANK2B: JUMPE B,YANK1 ;IF NULL BLOCK
PUSHJ P,GETIN ;GET A WORD
PUSHJ P,DEPWRD ;PUT INTO CORE
SOJG B,.-2 ;MORE TO DO?
JRST YANK1 ;NO, GET NEXT BLOCK
YANK3: PUSHJ P,GETIN ;GET A WORD OF ASCIZ BLOCK
PUSHJ P,DEPWRD ;DEPOSIT IT
ANDI A,177 ;GET RID OF ALL BUT LAST BYTE
JUMPE A,YANK1 ;IF NULL, WE ARE DONE
JRST YANK3 ;ELSE LOOP
SUBTTL TABLE AND PROCESSORS FOR YANK MODULE
;THIS TABLE SETS UP CORRESPONDENCE BETWEEN CODES AND WHAT WE DO
;WHEN WE SEE EACH TYPE OF BLOCK. MOST BLOCKS ARE JUST YANKED INTO CORE
;BUT SEVERAL TYPES GET SPECIAL HANDLING.
BLKCOD: 1 ;A CODE BLOCK
2 ;A SYMBOL BLOCK
11 ;A POLISH BLOCK
5 ;END BLOCK
1040 ;END BLOCK
3 ;HI SEGMENT ITEM
400 ;F40 ITEM
401 ;F40 ITEM
LI$TRC ;TRACE ITEM
YTABLE: PRGCOD
PRGSYM
POLFIX
ENDPRG
ENDPRG
HISEGI
E$$FF4
E$$FF4
TRACEI
BLKLEN==.-YTABLE
$KILL(FF4,Cannot apply FIX to F40 produced REL file)
;HERE TO HANDLE THE CODE BLOCK ITEMS. WE STORE A POINTER TO THE FIRST ONE
;OF THESE.
PRGCOD: SKIPN SPCLOC ;FIRST TIME HERE?
MOVEM C,SPCLOC ;NO,SAVE POINTER
PUSHJ P,COUNT ;GET SIZE OF BLOCK
MOVE T,C ;SO WE CAN KNOW THE END
ADD T,B ;
MOVEM T,EPCLOC ;
AOS CBHEAD ;ADD ONE TO NUMBER OF LINK CODE BLOCKS
JRST YANK2B ;THEN POLISH OFF BLOCK
;HERE TO HANDLE SYMBOL BLOCK ITEMS. STORE POINTER TO BEGINNING AND END
PRGSYM: SKIPN SSTLOC ;FIRST TIME?
MOVEM C,SSTLOC ;YES, STORE POINTER
PUSHJ P,COUNT ;GET SIZE OF BLOCK
MOVE T,C ;START OF BLOCK
ADD T,B ;AND NOW (T) IS LAST WORD USED
MOVEM T,ESTLOC ;END OF SYMBOL TABLE
AOS SBHEAD ;INCREMENT NUMBER OF KNOWN SYMBOL BLOCKS
JRST YANK2B ;FINISH UP
;HERE WHEN END OF PROGRAM IS SEEN
ENDPRG: MOVEM A,SEB ;STORE IN SAFE PLACE
SOS C ;BACK OFF ONE
MOVEM C,PELOC ;AND MARK END OF PROGRAM
PUSHJ P,COUNT ;SIZE OF BLOCK
MOVEI T,SEB+1 ;STORE IN SAVE-END-BLOCK
ENDPR1: PUSHJ P,GETIN ;INPUT WORD
MOVEM A,(T) ;AND INTO SAVE BLOCK
AOS T ;UPDATE
SOJG B,ENDPR1 ;MORE TO DO?
PUSHJ P,ICBSET ;SET UP INDEX TO IN-CORE BLOCKS
SETOM PRGINC ;CURRENTLY A PROGRAM IN CORE
JRST CPOPJ1 ;NO,RETURN OVER EOF RETURN
;ROUTINE TO SET UP POINTER TO HI SEGMENT ITEM
HISEGI: SKIPN HSILOC ;MARK HISEGMENT ITEM LOCATION
MOVEM C,HSILOC ;
JRST YANK2A
;ROUTINE TO SET UP POINTER TO BEGINNING AND END OF TRACE BLOCK AREA
TRACEI: SKIPN STBLOC ;MARKED START OF TRACE BLOCKS?
MOVEM C,STBLOC ;NOT YET, DO SO NOW
PUSHJ P,COUNT ;AND GET COUNT
MOVE T,C ;POINT TO END
ADD T,B ;
MOVEM T,ETBLOC ;AND MARK IT
JRST YANK2B ;FINISH UP READING BLOCK
; HERE TO ADD ONE TO COUNT OF POLISH BLOCKS IN PROGRAM
POLFIX: AOS PBHEAD ;ANOTHER POLISH BLOCK
JRST YANK2A ;POLISH OFF THE BLOCK
;ROUTINE TO DEPOSIT A WORD FROM REGISTER A INTO THE END OF CORE. (C)
;IS THE ADDRESS TO DEPOSIT INTO. MORE CORE IS OBTAINED AS NEEDED.
DEPWRD: AOS C ;UPDATE DEPOSIT ADDRESS
MOVEM C,.JBFF## ;AND MAKE IT BE NEXT FREE
DEPWD1: CAMG C,.JBREL## ;ARE WE PAST OUR MEMORY?
JRST DEPWD2 ;NO,DEPOSIT
PUSH P,C ;SAVE C
CORE C, ;GET CORE
JRST NECERR ;NOT ENOUGH CORE
POP P,C ;RESTORE C
JRST DEPWD1 ;BE SAFE, CHECK AGAIN
DEPWD2: MOVEM A,(C) ;DEPOSIT WORD
POPJ P, ;AND RETURN
; ROUTINE TO SET UP INDICES TO BLOCKS REFERENCED OFTEN
ICBSET: MOVE T1,CBHEAD ;GET COUNT OF BLOCKS
MOVEM T1,CBINIT ;REMEMBER NUMBER OF INITIAL BLOCKS
ADDI T1,NCBMAX ;ADJUST FOR MAX NR. OF NEW BLOCKS
PUSHJ P,GETCOR ;GET THAT CORE
MOVEM T1,CBHEAD ;STORE STARTING LOCATION OF INDEX
MOVE T1,PBHEAD ;GET NUMBER OF EXISTING POLISH BLOCKS
MOVEM T1,PBINIT ;STORE NR. OF INITIAL BLOCKS
ADDI T1,NPBMAX ;ADD IN MAX. NEW BLOCKS
PUSHJ P,GETCOR ;GET ENOUGH CORE FOR INDEX
MOVEM T1,PBHEAD ;STORE IT AWAY FOR NOW
MOVE T1,SBHEAD ;DO SAME FOR SYMBOL BLOCKS
MOVEM T1,SBINIT ;REMEMBER NUMBER OF EXISTING BLOCKS
ADDI T1,NSBMAX ;ADD EXISTING+MAX. NEW
PUSHJ P,GETCOR ;ALLOCATE CORE
MOVEM T1,SBHEAD ;STORE THE HEADER ADDRESS PART
MOVE T2,CBHEAD ;T1 IS SYMBOLS, T2 IS CODE & T3 POLISH
MOVE T3,PBHEAD ;
MOVE C,PSLOC ;START WITH FIRST WORD OF LOADED PROGRAM
ICBSE1: HLRZ A,0(C) ;GET A HEADER WORD
CAIN A,1 ;IS IT CODE BLOCK?
JRST ICBSE3 ;YES, GO HANDLE IT
CAIN A,2 ;IS IT SYMBOL BLOCK?
JRST ICBSE4 ;YES, GO HANDLE IT
CAIN A,11 ;IS IT POLISH BLOCK?
JRST ICBSE5 ;YES, GO HANDLE IT
CAILE A,3777 ;ASCIZ TEXT?
JRST ICBS2A ;YES, GO HANDLE IT
ICBSE2: MOVE A,0(C) ;GET HEADER SET UP AGAIN
PUSHJ P,COUNT ;COUNT ADDITIONAL WORDS
ADDI C,1(B) ;GET TO NEXT BLOCK
CAML C,PELOC ;OVER END OF PROGRAM?
JRST ICBSE6 ;YES, FINISH UP AND RETURN
JRST ICBSE1 ;ELSE GET HEADER
ICBS2A: MOVE B,0(C) ;GET WORD IN QUESTION
AOS C ;INCREMENT POINTER
ANDI B,177 ;MASK TO LAST ASCII BYTE
JUMPE B,ICBSE1 ;IF NULL, STRING IS OVER
JRST ICBS2A ;ELSE GET NEXT WORD
ICBSE3: LDB B,[POINT 2,1(C),1] ;GET RELOCATION OF START ADDRESS
JUMPE B,ICBSE2 ;IGNORE IF ABSOLUTE CODE
MOVEM C,0(T2) ;STORE LOCATION OF CODE BLOCK
AOBJP T2,ICBSE2 ;DISCARD REST OF BLOCK
ICBSE4: MOVEM C,0(T1) ;STORE LOCATION OF SYMBOL BLOCK
AOBJP T1,ICBSE2 ;DISCARD REST OF BLOCK
ICBSE5: MOVEM C,0(T3) ;REMEMBER STARTING ADDRESS OF BLOCK
MOVEI B,2(C) ;POINT TO FIRST DATA WORD
HRLI B,(POINT 18,) ;CONVERT TO HALFWORD BYTE POINTER
SETZ D, ;CLEAR COUNTER
ICBS5A: ILDB A,B ;GET A BYTE
ADDI D,1 ;INCREMENT THE COUNT
TRNE A,1B18 ;IS THIS THE STORE OPERATOR?
JRST ICBS5B ;YES, THIS IS THE POINTER WE WANT
CAIE A,1 ;IS THIS "FULL WORD FOLLOWS"?
CAIN A,2 ; OR "SYMBOL NAME FOLLOWS"?
PUSHJ P,ICBS5C ;YES, SKIP FIRST OF TWO BYTES
CAIG A,2 ;FOR HW,FW OR SYM (0,1,2) SKIP A BYTE
PUSHJ P,ICBS5C ;SINCE ITS DATA
JRST ICBS5A ;LOOP FOR NEXT BYTE
ICBS5B: HRLM D,0(T3) ;STORE OFFSET TO STORE OPERATOR BYTE
HRRZS B ;CLEAR POINTER PART
CAMLE B,PELOC ;MAKE A SAFETY CHECK FOR RANGE
$STPCD(LOST PLACE IN POLISH FIXUP BLOCK) ;SINCE NEW CODES COULD BREAK US
AOBJP T3,ICBSE2 ;PROCEED TO NEXT BLOCK
ICBS5C: IBP B ;INCREMENT TO SKIP A BYTE
ADDI D,1 ;INCREMENT ILDB'S TO STORE OP.
POPJ P, ;RETURN
ICBSE6: HLRZS T1 ;ISOLATE COUNT
CAME T1,SBINIT ;AGREE WITH FIRST COUNT?
$STPCD(COUNTS OF SYMBOL BLOCKS DON'T AGREE)
MOVNS T1 ;NEGATE FOR AOBJN PTR
HRLM T1,SBHEAD ;STORE PTR FOR LATER USE
HLRZS T2 ;ISOLATE CODE BLOCK COUNT
CAMLE T2,CBINIT ; MUST BE .LE. (DUE TO IGNORING ABS CODE)
$STPCD(COUNTS OF CODE BLOCKS DON'T AGREE)
MOVEM T2,CBINIT ;STORE CORRECTED COUNT
MOVNS T2 ;NEGATE FOR PTR
HRLM T2,CBHEAD ;STORE IT AWAY FOR LATER USE
HLRZS T3 ;ISOLATE COUNT
CAME T3,PBINIT ;SHOULD MATCH PREVIOUS COUNT
$STPCD(COUNTS OF POLISH BLOCKS DON'T AGREE)
MOVNS T3 ;GET NEGATIVE COUNT
HRLM T3,PBHEAD ;STORE AS -COUNT,,ADDR
POPJ P, ;RETURN TO CALLER
SUBTTL PUTPG - ROUTINE TO WRITE BACK OUT THE CORRECTED PROGRAM
;/PUTPG/ - A ROUTINE TO WRITE OUT THE CORRECTED PROGRAM
; PUTPG COLLECTS THE VARIOUS NEW AND OLD BLOCKS AND RE-WRITES
; THEM INTO THE OUTPUT FILE. PUTPG COLLECTS CODE
; FROM THE FOLLOWING PLACES IN THE FOLLOWING ORDER:
; 1-ITEMS STORED IN THE BUFFER "ENTBLK", USUALLY ENTRY AND NAME ITEMS
; 2-EXISTING PROGRAM CODE
; 3-NEW PROGRAM CODE (FROM PATCOD)
; 3A-VERSION BLOCK (IF ANY) ,WHICH IS ACTUALLY A CODE BLOCK
; 4-OLD SYMBOL TABLE
; 5-NEW SYMBOL TABLE (FROM CRESYM)
; 6-ANYTHING ELSE TO END OF OLD PROGRAM
; 7-NEW TRACE BLOCKS
; 8-UPDATED END BLOCK (FROM SEB)
;
PUTPG: SKIPL PRGINC ;ANYTHING TO DO?
POPJ P, ;NO, SO JUST RETURN
SETZM PRGINC ;CLEAR FLAG
SOS B,SAVEAC ;GET OLD POINTER,ADJ BACK ONE
CAIGE B,ENTBLK ;ANYTHING TO DO?
JRST PUTPG3 ;NO, SO GO TO NEXT SECTION
MOVEI C,ENTBLK ;ELSE PUT BUFFER OUT
PUSHJ P,PUTTO ;FROM (C) TO (B)
PUTPG3: MOVE C,PSLOC ;GET START OF READ-IN STUFF
MOVE B,EPCLOC ;AND END OF OLD CODE
PUSHJ P,PUTTO ;COPY OUT
MOVEM C,SAVEAC ;SAVE POINTER
SKIPN NCBNUM ;ANY PATCH CODE?
JRST PTPG3A ;NO,GO TO NEXT SECTION
MOVE T,CBHEAD ;GET INDEX PTR
MOVE B,CBINIT ;GET COUNT OF OLD BLOCKS
HRLS B ;MAKE COUNT,,COUNT
ADD T,B ;NOW HAVE AOBJN PTR TO NEW BLOCKS
PTPG30: MOVE C,0(T) ;GET ADDRESS OF BLOCK
MOVE A,0(C) ;GET ACTUAL HEADER
PUSHJ P,COUNT ;COUNT WORDS
ADDI B,0(C) ;FROM (C) TO (B) PUTS OUT
PUSHJ P,PUTTO ;THE ENTIRE BLOCK
AOBJN T,PTPG30 ;ANOTHER BLOCK TO DO?
PTPG3A: SKIPN VERBLK ;WAS .VERSION DONE?
JRST PUTPG4 ;NO, GO TO NEXT SECTION
MOVEI C,VERBLK ;GET VERSION BLOCK START
MOVEI B,3(C) ;AND VERSION BLOCK END
PUSHJ P,PUTTO ;OUTPUT THE 4 WORD BLOCK
PUTPG4: MOVE C,SAVEAC ;RESTORE C
SKIPN B,ESTLOC ;ANY SYMBOL TABLE?
JRST PUTPG5 ;NO, SKIP IT
PUSHJ P,PUTTO ;ELSE COPY IT OUT
PUTPG5: SKIPN NSBNUM ;ANY CREATED SYMBOLS?
JRST PUTPG6 ;NO,NEXT SECTION
MOVEM C,SAVEAC ;SAVE C
MOVE T,SBHEAD ;GET PTR TO SYMBOL INDEX
MOVE B,SBINIT ;COUNT OF INITIAL BLOCKS
HRLS B ;PROPAGATE TO BOTH HALVES
ADD T,B ;ADJUST POINTER TO JUST NEW BLOCKS
PTPG50: MOVE C,0(T) ;GET AN INDEX ENTRY
MOVE A,0(C) ;GET HEADER
PUSHJ P,COUNT ;COUNT NUMBER OF WORDS AFTER HEADER
ADDI B,0(C) ;FROM AND TO POINTERS SET UP
PUSHJ P,PUTTO ;OUTPUT THE BLOCK
AOBJN T,PTPG50 ;BACK FOR ALL BLOCKS
MOVE C,SAVEAC ;RESTORE C
PUTPG6: MOVE B,ETBLOC ;GET END OF TRACE BLOCK
PUSHJ P,PUTTO ;SHOULD END STUFF
SKIPN B,TRCVAP ;AND NEXT COPY OUT ANY NEW BLOCKS
JRST PUTPG7 ;IN CASE
TXNE F,FSTMOD ;CHANGED EDIT?
MOVE B,TRCPTR ;YES,DONT COPY STATIC AREA
;FOR NEW EDIT INTO OLD MODULE
SOS B ;BACK OFF ONE FROM END
MOVEM C,SAVEAC ;SAVE C
MOVEI C,TRCBLK ;WRITE IT OUT
PUSHJ P,PUTTO ;FROM TRCBLK TO END OF TRCBLK
MOVEI A,TRCBLK ;MAKE SURE ONLY ONE EDIT IN CORE
CAMN A,TRCPTR ;
JRST PTPG6A ;ITS OK.
MOVS B,TRCPTR ;FROM TRCPTR TO
HRRI B,TRCBLK ;TRCBLK
BLT B,TRCBLK+TB$SIZ-1 ;SAVE ONLY THE STATIC AREA
MOVEI B,TRCBLK ;AND RESET POINTER
MOVEM B,TRCPTR ;TO CURRENT AREA
PTPG6A: MOVE B,[LI$TRC,,TB$SIZ] ;RESET STATIC HEADER
MOVEM B,TB$HED(A) ;
SETZM TB$LEN(A) ;AND THE LEN WORD FOR VARIABLE
ADDI A,TB$VAR ;UPDATE
MOVEM A,TRCVAP ;VARIABLE POINTER
MOVE C,SAVEAC ;
PUTPG7: MOVE B,PELOC ;COPY REST OF PROGRAM (IF ANY)
PUSHJ P,PUTTO ;AS A SAFETY MEASURE
MOVEI C,SEB ;AND LAST COMES THE END BLOCK
MOVE A,SEB ;PICK UP HEADER
PUSHJ P,COUNT
ADDI B,SEB ;END OF BLOCK
PUSHJ P,PUTTO ;
MOVE C,PSLOC ;RESTORE JBFF
MOVEM C,.JBFF## ;SO WE DONT SWELL TOO MUCH
POPJ P, ;RETURN TO CALLER
PUTTO: CAMLE C,B ;ANY MORE TO DO?
POPJ P, ;NO
MOVE T1,0(C) ;GET A WORD
PUSHJ P,BOUT ;AND WRITE IT
AOJA C,PUTTO ;AND LOOP
SUBTTL PROCESSORS AND ROUTINES FOR PATCHING
; /SYMSRC/ - ROUTINE TO FIND A SYMBOL IN REL FILE'S SYMBOL TABLE
; WHERE SYMBOL IN AC R IS SIXBIT
; /SYMSRN/ -ROUTINE TO FIND NEXT SYMBOL IN REL FILE'S SYMBOL TABLE
; WHERE SYMBOL IS NEXT OCCURANCE OF SYMBOL IN LAST CALL TO SYMSRC
;
; /SYMSRA/ - SAME AS SYMSRC, ONLY SYMBOL IS IN RADIX50
;
; INPUT- AC R CONTAINS SYMBOL IN SIXBIT OR RADIX50
; IF AC R IS 0, THEN ANY GLOBAL REQUEST (TYPE 60) SYMBOL IS A MATCH
; OUTPUT- AC A CONTAINS VALUE OF SYMBOL ( 2ND WORD OF PAIR)
; AC B CONTAINS 4 BIT CODE OF SYMBOL IN BITS 30-33
; AC C POINTS TO IN-CORE LOCATION OF 1ST WORD OF SYMBOL PAIR
; AC D CONTAINS THE RIGHT JUSTIFIED 2 BIT RELOC BYTE FOR CONTENTS OF AC A
; AC R IS PRESERVED, UNLESS IT WAS 0. IF IT WAS 0
; THEN RADIX50 NEXT GLOBAL SYMBOL NAME IS RETURNED
;
; RETURNS- CPOPJ=SYMBOL NOT FOUND CPOPJ1=SYMBOL FOUND
SYMSRC: JUMPE R,SYMSRA ;HANDLE 0 (WILD CARD) SAME
;FOR SIXBIT OR RADIX50
PUSH P,R ;SAVE SIXBIT OF SYMBOL
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
PUSHJ P,SYMSRA ;NOW CONTINUE, WITH R50
CAIA ;FAILURE RETURN
AOS -1(P) ;SKIP RETURN
POP P,R ;RESTORE ORIG AC R
POPJ P, ;RETURN
SYMSRA: SKIPL T,SBHEAD ;ANY SYMBOL TABLE LINK BLOCKS?
POPJ P, ;NO, JUST RETURN W/FAILURE
PUSH P,T1 ;SAVE T1-2
PUSH P,T2 ;...
SYMSR1: MOVE C,0(T) ;GET LOCATION OF SYMBOL BLOCK
MOVE A,(C) ;GET A HEADER
PUSHJ P,COUNT ;GET LENGTH OF BLOCK
MOVEI D,23(C) ;POINT TO NEXT RELOCATION WORD
MOVE T2,1(C) ;T2 GETS RELOC WORD
ADDI C,2 ;NOW POINT TO FIRST SYMBOL PAIR
SOS B ;AND ACCOUNT FOR SKIPPED WORD
SYMSR2: JUMPLE B,SYMSR4 ;END OF THIS BLOCK?
CAMN D,C ;TIME TO IGNORE RELOC WORD?
JRST [ SOS B ;YES
MOVE T2,0(C) ;GET RELOCATION WORD
MOVEI D,22(C) ;AND PTR
AOS C
JRST SYMSR2] ;AND TRY AGAIN
MOVE A,(C) ;GET A SYMBOL
TLZ A,740000 ;TURN OFF CODE BITS
LSHC T1,4 ;GET RELOC BYTE
JUMPE R,SYMS2B ;IF R/0 THEN DIFFERENT TEST FOR MATCH
CAMN R,A ;A MATCH?
JRST SYMSR3 ;YES,SET PTRS AND RETURN
SYMS2A: ADDI C,2 ;SKIP PAIR
SUBI B,2 ;DECREMENT COUNT
JRST SYMSR2 ;AND TRY AGAIN
SYMS2B: LDB R,[ POINT 4,0(C),3] ;GET TYPE CODE
CAIE R,60_-2 ;IS THIS A GLOBAL REQUEST?
SETZ R, ;NO, WE WILL CONTINUE W/NEXT SYMBOL
JUMPE R,SYMS2A ;IF NO MATCH, TRY NEXT
SETZ R, ;CLEAR FOR SAVE
;... AND FALL INTO "MATCH" CODE
SYMSR3: PUSH P,A ;SAVE AC
MOVE A,[XWD T1,SYMBLK] ;SAVE STATE
BLT A,SYMBLK+D ;FOR SYMSRN ROUTINE
POP P,R ;RESTORE SYMBOL NAME
MOVE A,1(C) ;GET VALUE OF SYMBOL INTO REG. A
LDB B,[POINT 4,0(C),3] ;AND BITS INTO B
LSH B,2 ;GET IT INTO BITS 30-33
LDB D,[POINT 2,T1,35] ;GET RELOCATION BYTE
AOSA -2(P) ;FORCE SKIP RETURN
SYMSR4: AOBJN T,SYMSR1 ;IF MORE SYMBOL BLOCKS, CONTINUE
T2POPJ: POP P,T2 ;RETURN, RESTORING
T1POPJ: POP P,T1 ;THE TWO ACS
POPJ P, ;
SYMSRN: PUSH P,T1 ;ALT. ENTRY POINT FOR REPEAT SYMBOL
PUSH P,T2 ;SAVE ACS FOR GOOD PDL PHASE
MOVS A,[XWD T1,SYMBLK] ;RESTORE ACS
BLT A,D ;FROM LAST SEARCH
JRST SYMS2A ;AND CONTINUE
; /WRDSRC/ - ROUTINE TO TAKE A VALUE AND FIND THE WORD IN THE
; REL FILE THAT CORRESPONDES TO THAT VALUE. I.E.
; GIVEN A VALUE OF N, FIND THE WORD IN THE REL FILE
; THAT WILL BE LOADED INTO WORD N OF THE CORE IMAGE.
;
; INPUT- AC A SHOULD CONTAIN A VALUE (PRESERVED)
; OUTPUT- AC C WILL CONTAIN THE IN-CORE POSITION OF THE DESIRED WORD
; AC B WILL CONTAIN THE IN-CORE POSITION OF THE HEADER WORD
; THE CODE ITEM THAT THE WORD APPEARS IN.
;
; RETURNS- CPOPJ=WORD IS NOT IN FILE, CPOPJ1=WORD IS IN FILE
;
WRDSRC: SKIPL T,CBHEAD ;LOAD AOBJN PTR TO CODE BLOCK INDEX
POPJ P, ;IF NONE,JUST RETURN
WRDSR1: MOVE B,0(T) ;GET ENTRY FROM INDEX
HLRZ C,0(B) ;GET BLOCK TYPE
MOVE D,2(B) ;POINT TO FIRST START ADDR WORD
CAMLE D,A ;IS START ADDR .GT. VALUE?
JRST WRDSR3 ;YES,SO CANT BE IN THIS BLOCK
HRRZ C,0(B) ;GET NR. OF DATA WORDS IN BLOCK
SUBI C,2 ;BACK OFF TWO AS ADDITIVE ADJ.
;I.E. SO S.ADDRESS OF BLOCK + (C)
;IS HIGHEST ADDR THIS BLOCK
ADD D,C ;GET HIGHEST ADDRESS THIS BLOCK
CAMGE D,A ;IF .LT. VALUE ,NOT IN BLOCK
JRST WRDSR3 ;SO GET NEXT ONE
MOVE D,A ;DESIRED VALUE
SUB D,2(B) ;MINUS START ADDRESS
ADDI D,3(B) ;PLUS BASE GIVES CORE POSITION
MOVE C,D ;RETURN IT IN C
JRST CPOPJ1 ;AND RETURN
WRDSR3: AOBJN T,WRDSR1 ;MORE TYPE 1 BLOCKS LEFT?
POPJ P, ;NO, RETURN W/FAILURE
; /FGREF/ - ROUTINE TO FIND THE IN-CORE ADDRESS OF THE SYMBOL TABLE
; OR CODE WORD THAT IS THE IMMEDIATE PREDECESSOR OF THE
; WORD WHOSE RELOCATABLE ADDRESS IS (A) , IN THE GLOBAL
; FIXUP CHAIN THAT STARTS WITH THE SYMBOL (R).
;
; INPUTS- AC A CONTAINS THE RELOCATABLE (LOAD) ADDRESS OF
; WORD WE THINK IS IN A GLOBAL CHAIN
; AC R CONTAINS A SIXBIT SYMBOL NAME THAT IS A GLOBAL
; WE THINK HEADS SOME CHAIN THAT WE THINK (A) IS
; A PART OF.
;
; OUTPUTS- AC C CONTAINS A 36 BIT VALUE THAT IS A BYTE POINTER
; TO BE USED TO ACCESS THE POINTER (PREV) THAT POINTS TO
; THE RELOCATABLE ADDRESS (A).
; THIS MAY BE A MEMBER OF A CHAIN, A SYMBOL TABLE ENTRY OR
; A BYTE IN A POLISH FIXUP BLOCK.
;
; RETURNS- CPOPJ=CANNOT FIND REFERENCE
; CPOPJ1 = REFERENCE FOUND.
;
; NOTE: ALT. ENTRY FGREFN FINDS NEXT GLOBAL REFERENCE
; NOTE: IF (R) IS 0 THEN ANY GLOBAL IS A MATCH.
;
;
FGREF: SETZM PBLAST ;CLEAR LAST USED POLISH BLOCK
MOVEM A,SAVEA ;SAVE REFERENCE
PUSHJ P,SYMSRC ;FIND FIRST REFERENCE TO SYM.
JRST FGREF6 ;NO SYMBOL TABLE ENTRY , TRY POLISH
FGREF1: CAIE B,60 ;IS IT A GLOBAL SYMBOL?
JRST FGREF5 ;NO,SKIP IT
JUMPE D,FGREF5 ;IF NO FIXUP, OR ABS. FIXUP, IGNORE IT
ADD C,[POINT 18,1,35] ;MAKE ACCESS TO RIGHT HALF
HRRZS A ;CLEAR BITS IN LH
CAMN A,SAVEA ;A MATCH?
JRST CPOPJ1 ;YES
MOVE A,0(C) ;FOLLOW CHAIN
CAIE A,-1 ;IF THIS IS SPECIAL FLAG OR
TXNE A,R5.FXA ;IF THERE IS ADDITIVE PROCESSING
JRST FGREF5 ;THEN THERE IS NO CHAIN
FGREF2: PUSHJ P,WRDSRC ;LOOKUP WORD WE POINT TO
$STPCD(GLOBAL chain points outside of REL file)
HRRZ A,0(C) ;GET ADDRESS FIELD
PUSHJ P,GETREL ;GET THE RELOCATION OF THE ADDRESS
TRNN D,1 ;IS IT RELOCATABLE ADDR TO FIXUP?
JRST FGREF5 ;NO. CALL IT END OF THIS CHAIN
FGREF3: HRLI C,(POINT 18,0,35) ;MAKE INTO RH ACCESS BYTE POINTER
CAMN A,SAVEA ;A MATCH?
JRST CPOPJ1 ;YES,TAKE GOOD RETURN
JRST FGREF2 ;NO,FOLLOW CHAIN
FGREF5:
FGREFN: SKIPE B,PBLAST ;INTO POLISH STUFF?
JRST FGREF7 ;YES, PROCESS IT
PUSHJ P,SYMSRN ;GET NEXT INSTANCE OF SYMBOL
JRST FGREF6 ;EXHAUSTED SYMBOLS, TRY POLISH
JRST FGREF1 ;PROCESS IT
FGREF6: SKIPN B,PBHEAD ;FETCH POINTER TO POLISH LIST
FGREF7: JUMPGE B,CPOPJ ;IF NONE OR FINISHED , FAIL
HRRZ C,0(B) ;GET THE ADDRESS OF THE BLOCK
ADD C,[POINT 18,2] ;OFFSET TO DATA, MAKE B.P.
HLRZ A,0(B) ;GET OFFSET TO STORE OPERATOR
ILDB D,C ;GET A BYTE
SOJG A,.-1 ;REPEAT TILL PROPER POSITION
TRNE D,1B18 ;MUST BE NEGATIVE AND
CAIGE D,-3 ;A WORD FIXUP (NOT SYMBOL)
JRST FGREF8 ;DISCARD BLOCK
AOBJP B,.+1 ;INCREMENT BOTH HALVES OF PTR
MOVEM B,PBLAST ;THIS IS LAST ONE EXAMINED
ILDB A,C ;GET THE ADDRESS TO STORE INTO
CAMN A,SAVEA ;IS THIS A MATCH?
JRST CPOPJ1 ;TAKE GOOD RETURN ON MATCH
CAIE D,-2 ;IS THIS A LEFT HALF FIXUP?
JRST FGREF2 ;NO,FOLLOW CHAIN
JRST FGREF7 ;ELSE GET NEXT BLOCK
FGREF8: AOBJN B,FGREF7 ;YES, NO CHAIN TO FOLLOW
POPJ P, ;RETURN FAIL WHEN DONE
; /GFIXUP/ - ROUTINE TO CHANGE GLOBAL CHAINS WHEN A WORDS POSITION IS CHANGED
;
; GFIXUP HUNTS DOWN THE GLOBAL CHAINS (AT MOST TWO,AT LEAST 0)
; THAT POINT TO A WORD AND UPDATES THEM TO POINT TO THE CORRECT
; PLACE. THIS ROUTINE SHOULD BE USED WHEN ANY WORD IS CHANGED
; IN LOCATION IN THE REL FILE.
;
; INPUTS- AC A SHOULD CONTAIN THE PRESENT RELOCATABLE ADDRESS OF
; WORD IN QUESTION.
; AC B SHOULD CONTAIN THE RELOCATABLE ADDRESS WHERE THE WORD
; IS GOING.
;
; OUTPUTS- UPDATED SYMBOL TABLE AND / OR CHAINS.
;
; RETURNS- ALWAYS CPOPJ
;
;
GFIXUP: PUSH P,B ;SAVE B ACROSS CALLS
PUSH P,A ;SAVE A ACROSS CALLS
SETZ R, ;DONT KNOW SYMBOL NAME
PUSHJ P,FGREF ;FIND FIRST REFERENCE
JRST GFIXU2 ;NOT IN ANY CHAIN
MOVE B,-1(P) ;GET NEW ADDRESS
DPB B,C ;UPDATE ADDRESS
MOVE A,0(P) ;RESTORE ADDRESS
PUSHJ P,FGREFN ;GET 2ND REFERENCE
JRST GFIXU2 ;NOT THERE
MOVE B,-1(P) ;GET NEW ADDRESS
DPB B,C ;STORE NEW LOCATION
GFIXU2: POP P,A ;RESTORE A
POP P,B ;RESTORE B
POPJ P, ;RETURN
; /NEWSYM/ - ROUTINE TO INSERT A SYMBOL PAIR INTO THE CREATED SYMBOL BLOCK
; FOR LATER MERGING WITH EXISTING SYMBOL BLOCK
;
; INPUT- AC R SHOULD CONTAIN A RADIX 50 SYMBOL NAME WITH APPROPRIATE
; BITS SET IN 0-3. IF NONE ARE SET, FLAGS ARE INSERTED WITH
; MEANING [LOCAL SYMBOL].
; AC A SHOULD CONTAIN THE VALUE (WORD 2 OF PAIR) DESIRED. NOTE
; THAT FOR LOCAL SYMBOLS THIS IS THE VALUE OF THE SYMBOL AND
; FOR GLOBAL REQUESTS, THIS IS THE ADDRESS TO DO THE FIXUP TO.
; AC B SHOULD CONTAIN THE 2 BIT RELOCATION BYTE FOR THIS
; SYMBOLS'S VALUE. THE USUAL WILL BE 01(2) MEANING
; RELOCATE THE RIGHT HALF.
;
;
;
; OUTPUT- UPDATED CRESYM AND CREPTR.
;
; RETURNS- CPOPJ=NO ROOM FOR SYMBOL CPOPJ1=SYMBOL INSERTED
;
NEWSYM: TLNN R,740000 ;SOME BITS ON?
TXO R,R5.LCL ;NO, MAKE IT A LOCAL SYMBOL
SKIPN NSBNUM ;FIRST TIME THRU HERE?
JRST NEWSY1 ;YES,NEED NEW BLOCK
HRRZ D,@LSYMHW ;GET COUNT OF CURRENT BLOCK
CAIE D,22 ;TIME FOR A NEW BLOCK
JRST NEWSY2 ;ELSE GO PROCESS
NEWSY1: AOS T,NSBNUM ;UNDER MAXIMUM NUMBER
CAILE T,NSBMAX ;OF SYMBOL BLOCKS AVAILABLE?
POPJ P, ;NO, OUT OF ROOM
PUSH P,T1 ;SAVE THE AC
MOVEI T1,SBSIZE ;GET ENOUGH CORE FOR FULL BLOCK
PUSHJ P,GETCOR ;FROM THE SYSTEM
MOVEM T1,LSYMHW ;REMEMBER WHERE BLOCK STARTS
MOVSI D,2 ;2 IS SYMBOL CODE
MOVEM D,(T1) ;STORE HEADER (0)
MOVE D,[BYTE (2) 0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1]
MOVEM D,1(T1) ;STORE RELOC (1)
HLRE C,SBHEAD ;GET FULL NEG. COUNT OF SYMBOL BLOCKS
HRRZ D,SBHEAD ;AND BASE ADDRESS OF INDEX
SUB D,C ;GET FIRST FREE WORD OF INDEX
MOVEM T1,0(D) ;STORE LOCATION OF THIS BLOCK
SUBI C,1 ;ONE WORD ADDED TO INDEX
HRLM C,SBHEAD ;RESTORE UPDATED POINTER
ADDI T1,2 ;UPDATE THE POINTER
MOVEM T1,CREPTR ;AND STORE IT
POP P,T1 ;RESTORE AC
NEWSY2: MOVE T,CREPTR ;FETCH POINTER
MOVEM R,0(T) ;STORE SYMBOL NAME
MOVEM A,1(T) ;AND ITS VALUE
MOVEI T,2 ;UPDATE COUNTERS
ADDM T,CREPTR ;TO CURRENT LOCATION
ADDM T,@LSYMHW ;TO BLOCK HEADER
CAIN B,1 ;CHECK FOR LABEL TYPE RELOC
JRST NEWSY3 ;USUAL CASE OF 01(2),SKIP THIS
MOVE T,LSYMHW ;LOAD ADDRESS OF BLOCK HEADER
HRRZ C,0(T) ;PICK UP RH OF HEADER (WORD COUNT)
ADD T,[POINT 2,1] ;CONVERT AC T TO BYTE POINTER TO
;RELOCATION WORD
IBP T ;UPDATE TO POINT TO RIGHT PLACE
SOJG C,.-1 ;
CAILE B,3 ;MAKE SURE WE DONT HAVE GARBAGE
$STPCD(Relocation argument incorrect)
DPB B,T ;STORE THE RELOCATION
NEWSY3: TLZ R,740000 ;TURN FLAGS OFF AGAIN
JRST CPOPJ1 ;TAKE GOOD RETURN
; THESE ARE AUXIALLIARY ENTRY POINTS TO NEWSYM.
; /GLRSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL REQUEST
; /GLDSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL DECLARATION
;
; INPUTS - SAME AS FOR ROUTINE NEWSYM
GLRSYM: TXOA R,R5.REQ ;FLAG AS GLOBAL REQUEST
GLDSYM: TXO R,R5.GLB ;FLAG AS GLOBAL DECLARATION
JRST NEWSYM ;AND CONTINUE
;/NEWCOD/ - ROUTINE TO INSERT A CODE WORD INTO THE PATCH CODE
; BLOCK FOR LATER MERGING WITH EXISTING CODE.
;
; INPUTS - AC C CONTAINS THE WORD OF CODE TO BE INSERTED.
; AC B CONTAINS THE 2 BIT RELOCATION FOR THIS WORD
;
; OUTPUTS- UPDATED PATCOD,PATPTR AND THEIR ASSOCIATED DATA ITEMS
; NOTE::: CPADDR MUST BE SET UP WITH LOCATION TO PATCH
; INTO. CPADDR,HI SEGMENT AND END BLOCKS WILL BE UPDATED ON
; EACH CALL. ALSO NOTE THAT CPSFLG MUST BE SET
; TO INDICATE THE SEGMENT TO PATCH INTO.
;
; RETURNS- CPOPJ=NO ROOM LEFT IN PATCOD CPOPJ1=WORD INSERTED.
NEWCOD: MOVE A,CPADDR ;LOAD PATCH ADDRESS
SKIPN NCBNUM ;IS PATCH POINTER INITED?
JRST NEWCO1 ;NO, NEED NEW BLOCK
HRRZ T,@LCODHW ;PICK UP COUNT
CAIE T,22 ;TIME FOR OUR FRIEND THE RELOC?
JRST NEWCO2 ;YES,FORCE NEW BLOCK
NEWCO1: AOS T,NCBNUM ;INCREMENT NUMBER OF NEW CODE BLOCKS
CAILE T,NCBMAX ;UNDER THE MAXIMUM AVAILABLE?
POPJ P, ;NO, RETURN WITH FAILURE
PUSH P,T1 ;SAVE AN AC
MOVEI T1,CBSIZE ;NUMBER OF WORDS PER LINK CODE BLOCK
PUSHJ P,GETCOR ;ASSIGN THE CORE
MOVE T,[XWD 1,1] ;HERE TO SET UP NEW BLOCK
MOVEM T,(T1) ;1)HEADER WORD
HRLZI T,(1B1) ;2)RELOCATION WORD
MOVEM T,1(T1) ;RELOCATE STARTING ADDRESS
MOVEM A,2(T1) ;3)STARTING ADDRESS
MOVEM A,LCADDR ;AND SAVE AS LAST ADDRESS USED
MOVEM T1,LCODHW ;SAVE POINTER TO LAST HEADER WD
PUSH P,A ;GET SOME ACS
PUSH P,B ;FOR UPDATING INDEX BLOCK
HLRE A,CBHEAD ;GET NEG. COUNT OF INDEX SIZE
HRRZ B,CBHEAD ;AND BASE ADDRESS OF INDEX
SUB B,A ;GET FIRST FREE LOCATION
MOVEM T1,0(B) ;STORE LOCATION OF HEADER
SUBI A,1 ;INDEX INCREASES IN SIZE BY ONE
HRLM A,CBHEAD ;RESTORE ADJUSTED HEADER
POP P,B ;RESTORE ACS
POP P,A ;FOR USE
ADDI T1,3 ;POINT TO FIRST FREE
MOVEM T1,PATPTR ;AND SAVE
POP P,T1 ;RESTORE AC
MOVE D,PATPTR ;SET UP DEPOSIT POINTER
JRST NEWCO3 ;GO INSERT CODE
NEWCO2: MOVE D,PATPTR ;PICK UP THE POINTER
SUB A,LCADDR ;SEE IF WORKING CONTIGUOSLY
CAIE A,1 ;WHICH IS USUAL
JRST [ADD A,LCADDR ;NOT CONTIGUUS, FORCE NEW BLOCK
JRST NEWCO1]
AOS A,LCADDR
NEWCO3: MOVEM C,0(D) ;STORE WORD OF CODE
AOS PATPTR ;AND IN-CORE BLOCK INDEX TOO
AOS CPADDR ;UPDATE THE ADDRESS TO PATCH
SKIPGE CPSFLG ;HI-SEGMENT FLAG UP?
JRST NEWC3A ;NO,SO USE LOW SEGMENT UPDATE
MOVSI T,1 ;ADD 1 TO LEFT HALF OF FIRST
MOVE A,HSILOC ;
SKIPE 2(A) ;[16]HISEG TYPE 3 BLOCK HAS 0
;[16]SO DONT INCREMENT IT
ADDM T,2(A) ;DATA WORD
AOS SEB+2 ;UPDATE END BLOCK TOO
JRST NEWC3B ;AND FINISH
NEWC3A: MOVEI T,SEB+2 ;POINT TO FIRST "END" DATA WORD
SKIPE HSILOC ;BUT IF HAVE A HI-SEGMENT,
AOS T ;POINT TO SECOND DATA WORD
AOS 0(T) ;UPDATE PROGRAM LOW-SEG BREAK
NEWC3B: AOS T,@LCODHW ;UPDATE NR WORDS IN HEADER
HRRZS T ;T NOW HAS THAT COUNT
JUMPE B,CPOPJ1 ;IF RELOC BITS 0, WE ARE DONE
LSH T,1 ;SHIFT BITS TO 36.-INDEX*2
MOVEI D,^D36 ;
SUB D,T
LSH B,(D) ;BITS NOW IN POSITION
MOVE T,LCODHW ;GET ADDRESS OF BLOCK HEADER
IORM B,1(T) ;RELOC IS ONE BELOW
JRST CPOPJ1 ;AND RETURN
; /CHGREL/ - ROUTINE TO CHANGE THE RELOCATION BITS FOR A WORD
; IN THE REL FILE.
;
; INPUT- AC B CONTAINS ADDRESS OF THE HEADER WORD OF THE
; LINK ITEM TYPE BLOCK THAT WORD IS IN.
; AC C CONTAINS THE ADDRESS OF THE WORD ITSELF WHOSE RELOCATION
; BYTE WE ARE CHANGING.
; AC D CONTAINS THE 2 BIT RELOCATION BYTE DESIRED ( IN BITS 34-35)
;
; ACS ARE PRESERVED
;
; RETURN- ALWAYS CPOPJ
;
CHGREL: PUSH P,T1 ;SAVE ACS T1-2 ,C
PUSH P,T2
PUSH P,C ;SAVE ACS
SUBI C,1(B) ;GET INDEX OF WORD IN THIS BLOCK
MOVE T1,1(B) ;GET ORIGINAL RELOC WORD
LSH C,1 ;DOUBLE THE INDEX
LSHC T1,-^D36(C) ;POSITION RELOC BYTE IN BITS 34-5 OF T1
TRZ T1,3 ;TURN THEM OFF
IOR T1,D ;MAKE THEM THE NEW ONES
MOVNS C ;NEGATE C
LSHC T1,^D36(C) ;REVERSE SHIFT (SHIFT INTO REVERSE?)
MOVEM T1,1(B) ;STORE RESULT
POP P,C ;RESTORE AC C
PJRST T2POPJ ;RETURN,RESTOREING T1-T2
; /GETREL/ - ROUTINE TO READ RELOCATION BYTE FOR A WORD
;
; INPUTS - AC B CONTAINS IN-CORE LOCATION OF HEADER
; AC C CONTAINS IN-CORE LOCATION OF WORD ITSELF
;
; OUTPUTS - AC D WILL CONTAIN IN BITS 34-35 THE TWO BIT RELOC. BYTE
;
GETREL: PUSH P,C ;SAVE AC C
SUBI C,1(B) ;GET INDEX
ASH C,1 ;MULT. * 2
MOVE D,1(B) ;GIVE D THE RELOCATION WORD
LSH D,-^D36(C) ;GET INTO RIGHT PLACE
ANDI D,3 ;MASK IT
POP P,C ;RESTORE C
POPJ P, ;RETURN
;/FNDEDT/ - ROUTINE TO FIND AN EDIT IN THE CURRENT MODULE
; IN CORE.
;
; INPUTS- AC A CONTAINS THE SIXBIT NAME OF THE EDIT TO LOOK FOR
;
; OUTPUTS- AC B CONTAINS THE POINTER TO THE TRACE BLOCK CONTAINING
; THE EDIT-TRACE INFORMATION.
;
; RETURNS- CPOPJ=EDIT WAS NOT FOUND CPOPJ1=EDIT WAS FOUND
;
FNDEDT: MOVE T,ETBLOC ;LOAD T WITH END OF OLD TRACE BLOCKS
SKIPN B,STBLOC ;ANY OLD TRACE BLOCKS?
JRST FNDED3 ;NO, SEE IF ANY ADDED
FNDED1: CAMN A,TB$EDT(B) ;A MATCH?
JRST CPOPJ1 ;YES, SO RETURN
PUSH P,A
PUSH P,B ;SAVE A-B
MOVE A,TB$HED(B) ;LOAD HEADER
PUSHJ P,COUNT ;AND COUNT
ADD B,0(P) ;GET ADDRESS NEXT HEADER
AOS B ;PAST END OF THIS BLOCK
POP P,A ;POP OFF
POP P,A ;RESTORE A
CAMG B,T ;OVER THE END OF CURRENT SEARCH
JRST FNDED1 ;NO, SEE IF MATCH ETC...
FNDED3: CAMN T,ETBLOC ;ARE WE DOING PART A?
SKIPN T,TRCPTR ;YES,DO WE HAVE PART B?
POPJ P, ;EITHER WERE DOING ADDED OR DONT HAVE
MOVEI B,TRCBLK ;BEGINNING OF IT
SUBI T,2 ;-1 TO ADJ PTR
;-1 BECAUSE DONT WANT TO SEE THIS
;EDIT
CAMLE B,T ;END .GT. BEGINNING?
POPJ P, ;RETURN /FAIL
JRST FNDED1 ;NO,SO CONTINUE SEARCH
;IS SET TO FIRST.FREE
; /CHKCNF/ - ROUTINE TO SEE IF THE ACT OF INSERTING,RE-INSERTING OR
; REMOVING AN EDIT CONFLICTS WITH THE [ASSOCIATED]
; SPECIFICATION OF AN EXISTING,ACTIVE EDIT IN THE
; CURRENT MODULE.
;
; INPUTS- AC A SHOULD CONTAIN THE SIXBIT NAME OF THE EDIT CURRENTLY
; BEING REMOVED OR INSERTED OR RE-INSERTED.
; AC B SHOULD CONTAIN :
; 1B0 IF THIS EDIT IS BEING REMOVED
; 1B1 IF REINSERTED OR INSERTED
;
; NOTE: CONFLICT WARNINGS ARE GENERATED INSIDE THE ROUTINE ITSELF.
; SO THERE IS ONLY ONE RETURN. CURRENTLY THE MESSAGES ARE ONLY
; WARNINGS, BUT A CHANGE TO FATAL INVOLVES ONLY CHANGEING THE
; MACRO TO "$KILL" AND CHANGING X$$CNF+1 TO JRST RSTRT1
;
; RETURNS- ALWAYS CPOPJ
;
CHKCNF: PUSH P,B ;SAVE AC B, IT HAS ARG
PUSHJ P,FRED ;FIND FIRST REFERENCE
JRST T1POPJ ;CLEAN STACK AND RETURN
JRST CHKCN2 ;FOUND REFERENCE, SO PROCESS
CHKCN1: PUSHJ P,FREDN ;HERE TO FIND NEXT REFERENCE
JRST T1POPJ ;TO RETURN WITH PDL PHASE CORRECT
CHKCN2: SKIPL 0(P) ;WAS ARG 1B1?
JRST CHKCN3 ;NO,SO EDIT IS BEING REMOVED
JUMPL C,CHKCN1 ;NO CONFLICT IS TB$AES WAS 1B1
MOVEI N,[ASCIZ/Insertion of edit /] ;ERROR MESSAGE
JRST CHKCN4 ;USE COMMON ERROR MESSAGE
CHKCN3: JUMPE C,CHKCN1 ;IS THERE A COMMON CONFLICT?
MOVEI N,[ASCIZ/Removal of edit /]
CHKCN4: $WARN(CNF,,N$STRG,$MORE) ;GIVE THE APPROPRIATE WARNING
MOVE T1,A ;GIVE EDIT NAME
PUSHJ P,.TSIXN##
CAMN T1,CUREDT ;IS THIS EDIT CURRENT EDIT?
JRST CHKC4A ;YES,DONT SAY WHO THEN
MOVEI T1,[ASCIZ / by edit /]
PUSHJ P,.TSTRG## ;SAY WHAT EDIT DOES THIS
MOVE T1,CUREDT ;ITS THE CURRENT EDIT
PUSHJ P,.TSIXN##
CHKC4A: MOVEI T1,[ASCIZ/ conflicts with edit /]
PUSHJ P,.TSTRG## ;
MOVE T1,D ;GIVE REFERENCE EDIT NAME
PUSHJ P,.TSIXN## ;
X$$CNF: PUSHJ P,.TCRLF##
TXZ F,FOTTY ;RESTORE NORMAL IO MODE
JRST CHKCN1 ;SEE IF MORE CONFLICTS
; /FRED/ - ROUTINE TO FIND FIRST REFERENCE TO A SPECIFIC EDIT
; /FREDN/- ROUTINE TO FIND NEXT REFERENCE TO A SPECIFIC EDIT
; THESE ROUTINES ARE USED TO FIND , IN THE TRACE
; BLOCKS OF THE MODULE IN CORE, ALL REFERENCES TO A SPEFICIC
; EDIT. FRED IS USED TO FIND THE FIRST SUCH REFERENCE AND
; SUCCESSIVE CALLS ARE TO FREDN TO FIND ANY OTHERS.
;
; INPUTS- AC A SHOULD CONTAIN A SIXBIT EDIT NAME, REFERENCE TO IT
; ARE WHAT TO LOOK FOR.
;
; OUTPUTS- AC A IS PRESERVED.
; AC B CONTAINS THE ADDRESS OF THE TRACE BLOCK IN WHICH THE
; REFERENCE WAS FOUND.
; AC C CONTAINS THE STATUS WORD (TB$AES) OF THE ASSOCIATED
; EDIT PAIR OF THE REFERENCE.
; AC D CONTAINS THE SIXBIT NAME OF THE EDIT THAT REFERS
; TO THE EDIT IN AC A.
;
; RETURNS- CPOPJ=NO REFERENCE FOUND OR ALL REFERENCES EXHAUSTED
; CPOPJ1 MEANS THAT THE ACS ARE SET UP WITH A REFERENCE.
;
;
FRED: MOVE T,ETBLOC ;LOAD T WITH FIRST PART SEARCH END
SKIPN B,STBLOC ;ANY TRACE BLOCKS?
JRST FRED4 ;NO, SEARCH ADDED BLOCKS
FRED1: MOVE C,TB$STA(B) ;GET IF ACTIVE WORD
JUMPE C,FRED3 ;IF NOT ACTIVE,IGNORE IT
HLRZ C,TB$LEN(B) ;GET THE VARIABLE AREA LENGTH
JUMPE C,FRED3 ;IF NO ASSOCIATED EDITS,SKIP BLOCK
MOVEI D,TB$VAR(B) ;START OF ASSOC EDIT AREA
FRED2: MOVE T1,0(D) ;GET AN A.E. NAME
CAMN T1,A ;SAME?
JRST [ MOVEM B,SAVEB ;SAVE ACS B-D FOR FREDN
MOVEM C,SAVEC ;
MOVEM D,SAVED ;
MOVE C, 1(D) ;LOAD WITH STATUS
MOVE D,TB$EDT(B) ;LOAD D WITH EDIT NAME
JRST CPOPJ1 ] ;TAKE GOOD RETURN
FRED2A: SOJLE C,FRED3 ;ANY MORE A.E.S THIS BLOCK?
ADDI D,AESIZ ;YES,GET NEXT
JRST FRED2 ;
FRED3: PUSH P,A ;SAVE A,B
PUSH P,B ;OVER CALL TO COUNT
MOVE A,TB$HED(B) ;GET HEADER
PUSHJ P,COUNT ;AND COUNT WORDS TO SKIP
ADD B,0(P) ;
AOS B
POP P,A
POP P,A ;CLEAR STACK,RESTORE A
CAMG B,T ;ARE WE DONE?
JRST FRED1 ;NO,SO EXAMINE THIS BLOCK
FRED4: CAMN T,ETBLOC ;END OF ORIG TRACE CODE?
SKIPN T,TRCPTR ;AND HAVE NEW TRACE CODE?
POPJ P, ;NO,WE ARE DONE.
MOVEI B,TRCBLK ;LOAD B WITH ADDRESS OF NEW STUFF
SUBI T,2 ;ADJUST POINTER
CAMLE B,T ;IS ONLY NEW T.B. CURRENT T.B.?
POPJ P, ;YES,SO DONT EXAMINE IT
JRST FRED1 ;NO, PROCESS IT
;ALTERNATE ENTRY FOR NEXT EDIT
FREDN: MOVE B,SAVEB ;RESTORE B-D
MOVE C,SAVEC
MOVE D,SAVED
JRST FRED2A ;CONTINUE
SUBTTL END OF CONDITIONAL (IFN FTBPT)
> ;NFI FTBPT
SUBTTL MAKLIB IO SUBROUTINES
;ROUTINES TO COPY FILES, COPY UP TO A GIVEN PROGRAM IN A FILE
;AND TO FIND A GIVEN PROGRAM IN A FILE AND COPY IT.
;THE COPY ROUTINE WILL COPY BINARY PROGRAMS FROM WHEREVER THE
;INPUT DEVICE HAPPENS TO BE WHEN IT IS CALLED, UP TO THE
;END OF FILE. SINCE COPY IS CALLED WITH A PUSHJ, THE END-OF-
;FILE EXIT IN INGET WILL EXIT TO THE PLACE THAT CALLED COPY.
COPY: PUSHJ P, READ ;READ A PROGRAM
POPJ P, ;EXIT WHEN ALL THROUGH FILE
PUSHJ P, WRITE ;WRITE OUT THE PROGRAM
JRST COPY ;RETURN FOR MORE PROGRAMS
;THE COPYTO ROUTINE WILL READ AND WRITE PROGRAMS FROM THE
;INPUT DEVICE UNTIL THE PROGRAM WHOSE NAME IS IN ACCUMULATOR
;R IS FOUND, AT WHICH TIME IT EXITS
COPYTO: PUSHJ P,RAD50 ;CHANGE NAME TO RADIX 50
COPYT1: PUSHJ P, READ ;READ A PROGRAM
JRST MNFERR ;EOF - MODULE NOT FOUND ERROR
CAMN R, A ;IS IT THE CORRECT PROGRAM?
POPJ P, ;YES, EXIT
PUSHJ P, WRITE ;NO, WRITE IT OUT
JRST COPYT1 ;READ SOME MORE PROGRAMS
;THE FINDCP ROUTINE WILL SEARCH THE INPUT FILE FOR A PROGRAM
;WHOSE NAME IS IN ACCUMULATOR R, AND HAVING FOUND IT, WILL
;WRITE IT OUT. IF THE CONTENTS OF AC R ARE ZERO, THE ENTIRE
;FILE IS COPIED.
FINDCP: JUMPE R, COPY ;COPY ENTIRE FILE?
PUSHJ P,RAD50 ;CONVERT NAME TO RADIX 50
FIND1: PUSHJ P, READ ;READ A PROGRAM FROM INPUT FILE
JRST MNFERR ;EOF, TRY REWINDING AND TRYING AGAIN
CAME R, A ;IS THIS THE RIGHT ONE?
JRST FIND1 ;NO, TRY AGAIN
JRST WRITE ;YES, WRITE IT OUT AND EXIT
;ROUTINE MSTGET RETRIEVES A PROGRAM NAME FROM THE MASTER
;DEVICE SPECIFICATIONS. IT SAVES THE POINTER IN FILBUF,
;CHANGES IT TO POINT TO ITS OWN BLOCK, THEN CALLS GETDEV
MSTGET: MOVE FPT, INBEG ;GET THE POINTER TO CURRENT FILE
MOVEI IOC,MIN ;SET FOR INPUT ON MASTER CHANNEL
JRST GETDEV ;CALL COMMON ROUTINE
;ROUTINE TRNGET RETRIEVES A PROGRAM NAME FROM THE TRANSACTION
;FILES. IT RESETS THE POINTER THAT MSTGET WIPED OUT, AND CALLS
;THE COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.
TRNGET: MOVE FPT, WLDTMP ;GET SAVED POINTER
CAMN FPT,INBEG ;IS THIS REALLY THE MASTER FILE?
JRST CPOPJ ;YES-LOSE NOW
MOVEI IOC,TRIN ;INPUT ON TRANSACTION CHANNEL
JRST GETDEV ;CALL COMMON ROUTINE
GETDEV: DPB IOC,[POINT 4,INGET2,12] ;STORE CHAN NR. FOR IN UUO
DPB IOC,[POINT 4,INGET3,12] ;AND FOR STATUS READING UUO
MOVEI T,MBUF+1 ;START WITH MASTER FILE BUFFER
CAIE IOC,MIN ;IS IT REALLY MASTER?
MOVEI T,TBUF+1 ;NO,ITS TRANSACTION
MOVEM T,IBUF1 ;STORE LOCATION OF INPUT BYTE POINTER
AOS T
MOVEM T,IBUF2 ;AND CURRENT BYTE COUNTER TOO.
SETZ R, ;IN CASE OF NO PROGRAM NAMES
HLRZ T2,.FXLEN(FPT) ;GET COUNT OF PROG NAMES
JUMPE T2,CPOPJ1 ;RETURN WITH R=0 IF NONE
CAIN IOC,TRIN ;DID WE COME HERE FROM TRNGET?
JRST GET1 ;YES SO USE DIFFERENT COUNTER
CAMG T2,NAMCTR ;ANY MORE NAMES TO RETURN?
POPJ P, ;NO MORE
MOVEI T2,.FXPRG(FPT) ;GET POINTER TO BASE OF NAMES
ADD T2,NAMCTR ;INDEX TO CURRENT NAME
MOVE R,(T2) ;RETURN NAME IN R
AOS NAMCTR ;INCREMENT COUNTER
JRST CPOPJ1 ;GOOD RETURN
GET1: CAMG T2,TNMCTR ;MORE TRANS NAMES TO RETURN?
PUSHJ P,GET2 ;MAYBE SOME IN ANOTHER FILE
MOVEI T2,.FXPRG(FPT) ;GET POINTER TO BASE OF TRN NAMES
ADD T2,TNMCTR ;INDEX TO CURRENT NAME
MOVE R,(T2) ;RETURN THE NAME IN R
AOS TNMCTR ;INCREMENT THE COUNTER
JRST CPOPJ1 ;SKIP RETURN
GET2: CAMN FPT,INEND ;ARE THERE MORE TRANS FILES?
JRST POPOUT ;NO MORE--NON SKIP RETURN
PUSHJ P,TRNCLS ;CLOSE CURRENT TRANS FILE
MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD## ;WILD LOOKUP FOR NEXT TRANS FILE
JFCL
SETZM TNMCTR ;CLEAR COUNTER
MOVX T1,.IOBIN ;ASSUME BINARY INPUT
DPB T1,[POINTR(OPNBLK+.OPMOD,IO.MOD)] ;STORE APPROPRIATE MODE
MOVEI T1,TBUF ;BUFFER HEADER POINTER
MOVEM T1,OPNBLK+.OPBUF ;PUT THIS STUFF IN THE OPEN BLOCK
OPEN TRIN,OPNBLK ;OPEN A NEW TRANS FILE CHANNEL
JRST OPNFAI
LOOKUP TRIN,LKPBLK ;LOOKUP THE NEW TRANS FILE
JRST LKPFAI ;LOOKUP FAILED
INBUF TRIN, ;SET UP BUFFER
MOVE FPT,WLDTMP ;SET UP FILE POINTER
JRST CPOPJ ;GO BACK TO GETDEV CODE
CPOPJ1: AOSA (P) ;GOOD RETURN
POPOUT: POP P,(P) ;POP UP ONE LEVEL
CPOPJ: POPJ P, ;EXIT
SUBTTL ROUTINE TO INPUT ONE PROGRAM AT A TIME
;THE FIRST WORD THAT THE PROGRAM READS WILL BE A BLOCK HEADER.
;BLOCKS ARE READ UNTIL AN ENTRY BLOCK IS FOUND, AND THE ENTIRE
;ENTRY BLOCK IS STORED IN AN INTERNAL BUFFER,SIZE PERMITTING.
;FOLLOWING THAT, THE NAME BLOCK IS READ, AND THE NAME OF THE
;PROGRAM IS RETURNED IN ACCUMULATOR A. PROVISION IS MADE FOR
;BLOCKS OF WORD COUNT ZERO. THE SECTION OF CODING AROUND READ2
;DELIBERATELY OMITS THIS CHECK IN ORDER TO READ IN THE NEXT
;BLOCK HEADER WITH A MINIMUM OF INSTRUCTIONS. ORDINARILY, EACH
;PROGRAM WILL BEGIN WITH AN ENTRY BLOCK, BUT THE ROUTINE WILL
;ALSO ALLOW THE PROGRAM TO BEGIN WITH A NAME BLOCK IF NO
;ENTRY BLOCK IS SEEN.
READ: MOVEI C,ENTBLK ;SET UP POINTER TO BUFFER
READ1: PUSHJ P,GETIN ;GET A BLOCK HEADER
HLRZ B, A ;GET THE BLOCK CODE
CAILE B,3777 ;IS IT ASCIZ TEXT BLOCK?
JRST READ17 ;YES,HANDLE IT DIFFERENTLY
MOVSI T,-BLKTYL ;MAKE UP AOBJN POINTER
READ2B: CAMN B,BLKTYP(T) ;SEARCH THE TABLE OF BLOCKTYPES AND COMPARE
JRST @RTABLE(T) ;FOUND A MATCH--GO PROCESS IT
AOBJN T,READ2B ;NOT END YET--KEEP SEARCHING
CAIG B,37 ;TEST FOR LEGAL BLOCKTYPES
JRST READ2D ; THESE ARE CLEARLY LEGAL
CAIL B,1000 ;IF 1000-1777 ALSO LEGAL
CAILE B,1777 ;NEW TYPES
JRST IBTERR ;ELSE ITS AN ERROR
READ2D: PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ1 ;WORD COUNT OF ZERO?
READ2: CAML B,@IBUF2 ;DOES BLOCK OVERLAP IO BUFFERS?
JRST READ3 ;ADJUST B AND GET ANOTHER BUFFER
MOVE A,@IBUF2 ;NO, DIDDLE BUFFER HEADER COUNT
SUB A, B ;ELIMINATE BLOCK OF LENGTH C(B)
MOVEM A,@IBUF2 ;PUT NEW WORD COUNT BACK
ADDM B,@IBUF1 ;MOVE BYTE POINTER PAST BLOCK
JRST READ1 ;GET NEXT BLOCK
READ3: SUB B,@IBUF2 ;ACCOUNT FOR REST OF THIS BUFFER
SETZM @IBUF2 ;FORCE ANOTHER BUFFER
PUSHJ P,GETIN ;GET ANOTHER BUFFER OF INPUT
JRST READ2 ;CHECK AGAIN
;CODE MODIFIED TO HANDLE MORE THAN ONE ENTRY BLOCK.
;FAIL AND SAIL BOTH ISSUE MULTIPLE ENTRY BLOCKS.
SIZZ==SIZE-<<SIZE+21>/22>-4 ;ACCOUNT FOR HDR BLKS, RELOC WDRS, PROGNAME
READ4: SETZM ENTBLK ;SAME AS (C) AT PRESENT
HRLI C,-1 ;AOBJN WILL OVERFLOW FIRST TIME
TRNE A,-1 ;TEST FOR ZERO WORD COUNT
JRST READ5 ;NO
PUSHJ P,GETIN ;YES, THROW AWAY RELOCATION WORD
ADDI C,1 ;UPDATE INSERT COUNTER
SETZB A,(C) ;ENTRY BLOCK RELOCATION IS ALWAYS ZERO
;BACK HERE FOR EACH NEW BLOCK
READ5: MOVNI B,400000(A) ;-1 IN LH, 377777-CT IN RH
HRRZS A
ADD A,ENTBLK ;NEW COUNT IF IT FITS
CAILE A,SIZZ ;TOO MUCH NOW?
TXOA F,ERRB ;YES, MARK ENTRY BLOCK TOO BIG
MOVEM A,ENTBLK ;NO, UPDATE USED COUNT
;HERE FOR EACH NEW WORD
READ6: TRNN B,377777 ;END OF LOADER BLOCK?
JRST READ8 ;YES, CHECK NEXT
AOBJN B,NXTWRD ;TIME FOR SOME RELOC BITS?
PUSHJ P,GETIN ;YES, GET THEN AND TOSS THEM AWAY
HRLI B,-22 ;AND RESET COUNT
NXTWRD: PUSHJ P,GETIN ;GET A DATA WORD
;ROUTINE TAKEN FROM LOADER
AOBJN C,READ7 ;NEED TO INSERT RELOC WORD?
TXNN F,ERRB ;YES, UNLESS NOT INSERTING
SETZM (C) ;ALL ENTRY RELOCS ARE 0
ADD C,[-22,,1] ;LH 0 BEFORE ADD, SET UP NEXT
READ7: TXNN F,ERRB ;ARE WE INSERTING?
MOVEM A,(C) ;YES, PUT IT AWAY
JRST READ6 ;LOOP
READ8: PUSHJ P,GETIN ;GET NEXT HEADER WORD
HLRZ B,A ;TYPE
CAIN B,4 ;ANOTHER ENTRY?
JRST READ5 ;YES, STORE IT
;PROGRAM NAME - FINISH ENTRY OUT
MOVEI B,4 ;ENTRY BLOCK TYPE
HRLM B,ENTBLK ;NOW CORRECT TYPE,,COUNT
HRLI C,0 ;CLEAR LH COUNT
AOJA C,READ9 ;STORE NAME BLOCK HEADER AND CONTINUE
READ9: MOVEM A, (C) ;STORE NAME BLOCK HEADER
ADDI C,1
PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ13 ;WORD COUNT OF ZERO?
HRROI A,-2 ;SECOND WORD READ WILL BE
MOVEM A,MCOUNT ;WILL BE PROGRAM NAME
READ11: PUSHJ P,GETIN ;GET A WORD
MOVEM A, (C) ;STORE IT
AOSN MCOUNT ;IF SECOND WORD READ,
MOVEM A,TMPMOD ;STORE MODULE NAME
AOJ C, ;INCREMENT BUFFER POINTER
SOJG B,READ11 ;DONE READING YET?
PUSHJ P,READ18 ;FILTER OUT NULLS FROM PROGRAM NAME
MOVE A,TMPMOD ;AND USE FILTERED NAME
READ13: MOVE N,A ;SET UP FOR PRINT OUT
TXNE F, ERRB ;ERROR CONDITION?
$KILL(ETL,ENTRY block is too large to read in for module,N$50)
TXNN F,XFLG ;INDEX FLAG ON?
JRST CPOPJ1 ;NO, SKIP EXIT
JRST INDEX1 ;YES SAVE ENTRIES
READ14: TXO F,F4IB ;DONT OUTPUT DURING F4 SEARCH
PUSH P,C ;SAVE ENTRY BLOCK
PUSHJ P,F4 ;PASS F4 BLOCKS
POP P,C ;RESTORE ENTRY BLOCK
TXZ F,F4IB ;TURN OFF IGNORE BIT
HRRZM C,END1 ;FORTRAN CANNOT DO ANY BETTER
SETZM END2 ;CLEAR FIRST TIME FLAG
JRST READ1 ;GO PROCESS NEXT PROGRAM
READ15: PUSHJ P,COUNT ;GET SIZE OF BLOCK
SETZM END1 ;CLEAR STORAGE
SETZM END2
SOJE B,READ1 ;SHOULD N'T BE
PUSHJ P,GETIN ;GET RID OF BYTE WORD
PUSHJ P,GETIN ;GET FIRST END WORD
HRLZM A,END1 ;STORE IT
SOJE B,READ1 ;ONLY ONE WORD?
PUSHJ P,GETIN ;NO
HRLZM A,END2 ;STORE 2ND
SOJE B,READ1 ;SHOULD BE END
JRST READ2 ;JUST IN CASE
READ16: TXOE F,NOWARN ;DO WE WANT A MESSAGE?
JRST RD16B ;SKIP MESSAGE
$WARN(NIO,OUTPUT file ,,$MORE)
MOVEI T1,BCKBLK ;POINT TO SAVED OUTPUT SPEC
MOVEI T2,BCKBLK+3 ;T1/OPEN INFO T2/FILE INFO
PUSHJ P,.TOLEB## ;AND TELL USER
MOVEI T1,[ASCIZ " will not be INDEXed"]
PUSHJ P,.TSTRG## ;OUTPUT REST OF LINE
X$$NIO: PUSHJ P,.TCRLF## ;FINISH MESSAGE
TXZ F,FOTTY ;NO MORE FORCED IO TO TELETYPE
RD16B: SETZM @IBUF2 ;FORCE NEXT BUFFER
PUSHJ P,GETIN ;INPUT THE NEXT BLOCK
JRST READ1+1 ;AND RETURN TO CODE
READ17: ANDI A,376 ;[64] GET RID OF ALL BUT LAST BYTE (376 NOT 177)
JUMPE A,READ1 ;IF STRING EXHAUSTED,GET NEXT BLOCK
PUSHJ P,GETIN ;ELSE GET THE NEXT BYTE
JRST READ17 ;AND REPEAT LOOP
READ18: PUSH P,T1 ;GET A REGISTER TO COUNT IN
MOVEI T1,1 ;FOR KEEPING RADIX POSITION STRAIGHT
MOVE A,TMPMOD ;GET UNFILTERED PROGRAM NAME
SETZM TMPMOD ;CLEAR RESULT
RD18A: JUMPE A,T1POPJ ;RETURN IF DONE, RESTORING TEMP AC
IDIVI A,50 ;GET A CHARACTER
JUMPE B,RD18A ;IF NULL, THROW IT OUT
IMUL B,T1 ;GET INTO RIGHT POSITION
ADDM B,TMPMOD ;AND STORE INTO RESULT
IMULI T1,50 ;FOR NEXT DIGIT,GET POSITION RIGHT
JRST RD18A ;REPEAT AGAIN
;BLKTYP IS A TABLE OF LEGAL BLOCKTYPES RECOGNIZED BY FUDGE.
;WHEN A MATCH BETWEEN THE CODE IN THE LEFT HALF OF THE BLOCK
;HEADER AND A VALUE IN THE TABLE IS FOUND THE
;CORRESPONDING PART OF THE READ ROUTINE IS JUMPED TO.
;RTABLE IS A TABLE OF LABELS FOR THE APPROPRIATE SECTIONS OF CODE
;IN THE READ ROUTINE. THESE SECTIONS OF CODE ARE ACCESSED BY A
;JRST @RTABLE(T) WHERE T IS USED AS AN INDEX.
BLKTYP: EXP 14 ;INDEX BLOCK
EXP 4 ;ENTRY BLOCK
EXP 1001 ;ENTRY BLOCK
EXP 1002 ;LONG ENTRY BLOCK
EXP 6 ;NAME BLOCK
EXP 1003 ;NAME BLOCK
EXP 401 ;SPECIAL MANTIS(F40)DEBUGGER
EXP 400 ;FORTRAN 4 SIGNAL WORD
EXP 5 ;END BLOCK
EXP 1040 ;END BLOCK
BLKTYL== .-BLKTYP ; TABLE LENGTH
RTABLE: READ16
READ4
READ4
READ4
READ9
READ9
READ14
READ14
READ15
READ15
SUBTTL ROUTINE TO OUTPUT ONE PROGRAM AT A TIME
;THE WRITE SUBROUTINE WILL OUTPUT AN ENTIRE BINARY RE-
;LOCATABLE PROGRAM AS WRITTEN BY MACRO6. IT ASSUMES THAT THE
;ENTRY BLOCK AND NAME BLOCK FOR THE PROGRAM ARE IN THE
;INTERNAL BUFFER ENTBLK, AND OUTPUTS THESE BEFORE PICKING UP
;MORE BLOCKS FROM THE CURRENT INPUT DEVICE. BLOCKS ARE READ
;AND WRITTEN UNTIL THE END BLOCK HAS BEEN PROCESSED. PROVISION I
;IS MADE FOR BLOCKS WITH A WORD COUNT OF ZERO.
WRITE: SUBI C, ENTBLK ;GET COUNT OF ENTRY BLOCK
JUMPE C, WRITE3 ;NOTHING TO OUTPUT?
MOVEI B, ENTBLK ;GET A POINTER IN B
WRITE2: MOVE T1, (B) ;GET A BINARY WORD
PUSHJ P, BOUT ;OUTPUT IT
AOJ B, ;INCREMENT POINTER
SOJG C, WRITE2 ;KEEP GOING UNTIL BUFFER EMPTY
WRITE3: PUSHJ P,GETIN ;GET A BLOCK HEADER
HLRZ B,A ;GET THE BLOCK TYPE CODE
TXNN F,NOLOCB ;DELETE LOCAL SYMBOLS?
JRST .+3 ;NO
CAIN B,2 ;IS IT A SYMBOL BLOCK?
JRST DELLOC ;GO DELETE LOCAL SYMBOL
;COME BACK TO WRITE3
;UNLESS EXIT ON END-OF-FILE
MOVE T1,A
PUSHJ P,BOUT ;OUTPUT IT
CAIE B, 401 ;SPECIAL MANTIS F4?
CAIN B, 400 ;IS THIS A FORTRAN IV SIGNAL WORD?
JRST F4 ;YES, PROCESS F4 OUTPUT
CAILE B,3777 ;IS THIS ASCIZ TEXT?
JRST WRITE5 ;YES,HANDLE SPECIALLY
MOVEM B, SAVEBT ;SAVE THE BLOCK TYPE
PUSHJ P, COUNT ;NO, GET SIZE OF BLOCK
JUMPE B, WRITE3 ;WORD COUNT OF ZERO?
WRITE4: PUSHJ P,GETIN ;OUTPUT THE BLOCK
MOVE T1,A
PUSHJ P, BOUT ;...
SOJG B, WRITE4 ;LOOP BACK UNTIL DONE
MOVE A, SAVEBT ;RETRIEVE THE BLOCK TYPE
CAIE A,1040 ;WAS IT AN END BLOCK?
CAIN A, 5 ;WAS IT AN END BLOCK?
POPJ P, ;EXIT
JRST WRITE3 ;NO, RETURN FOR MORE BLOCKS
WRITE5: ANDI A,177 ;DISCARD ALL BUT LAST BYTE
JUMPE A,WRITE3 ;IF NULL, WE ARE DONE
PUSHJ P,GETIN ;ELSE GET NEXT WORD
MOVE T1,A ;AND THEN WRITE
PUSHJ P,BOUT ;IT OUT ,THEN REPEAT
JRST WRITE5 ;LOOP
; /COUNT/ - THIS ROUTINE CALCULATES THE LENGTH OF THE VARIOUS BLOCKS
; USED BY THE TRANSLATORS. THE ROUTINE ESSENTIALLY JUST RETURNS
; THE CONTENTS OF THE RIGHT HALF OF THE HEADER WORD FOR
; NEW LINK ITEM TYPES (1000-3777) AND RETURNS A COUNT ADJUSTED FOR
; HIDDEN RELOCATION WORDS FOR OLD LINK ITEM TYPES (0-777).
;
; INPUT- AC A SHOULD CONTAIN THE CONTENTS OF THE
; BLOCK HEADER WORD
;
; OUTPUT- AC B WILL CONTAIN THE POSITIVE NUMBER OF
; WORDS THAT FOLLOW THE BLOCK HEADER WORD.
;
COUNT: PUSH P,A ;SAVE HEADER
JUMPE A,CEXIT ;ZERO WORD HAS ZERO LENGTH
HLRZ B,A ;GET TYPE INTO B
HRRZS A ;A GETS RAW WORD COUNT
CAILE B,3777 ;IN RANGE OF REASON?
$STPCD(Attempt to compute length of ASCIZ text block)
CAIE B,14 ;IS THIS INDEX TYPE BLOCK OR
CAIL B,1000 ;NEW LINK TYPE?
JRST CEXIT ;YES, HEADER COUNT ALREADY CORRECT
CAIG A,22 ;IF LE 18 WORDS, JUST
AOJA A,CEXIT ;ADD ONE AND EXIT
IDIVI A, 22 ;1 SUBHEADER PER 18 DATA WORDS
SKIPE B ;IF REMAINDER,
ADDI A,1 ;ROUND UP
HRRZ B,0(P) ;ADD TO RAW COUNT
ADDI A,0(B) ;TO GET ADJ TOTAL
CEXIT: MOVE B, A ;RESULTS IN AC B
POP P,A ;RESTORE HEADER
POPJ P, ;EXIT
SUBTTL ROUTINE TO HANDLE FORTRAN OUTPUT
;SUBSECTION OF THE WRITE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. OTHER BLOCKS ARE MERELY COPIED OUT.
;THE BLOCK TYPES ARE GIVEN BY THE FOLLOWING TABLE
;----------------------------------------------------------------
;BITS 0-17 BITS18-23 BITS 24-35 TYPE
;777777 70 N DATA STATEMENT
;777777 50 N ABSOLUTE MACHINE CODE
;777777 77 N MANTIS DATA
;777777 0 - PROGRAMMER LABELS
;777777 31 - MADE LABELS
;777777 60 - ENTRY LABELS
;777777 777776 END BLOCK
;-----------------------------------------------------------------
F4: PUSHJ P,GETIN ;GET A FORTRAN IV BLOCK HEADER
PUSHJ P, OUT4 ;OUTPUT IT
TLC A, -1 ;TURN ONES TO ZEROES IN LEFT HALF
TLNE A, -1 ;NO, WAS LEFT HALF ALL ONES?
JRST F4 ;NO, IT WAS CALCULATED MACHINE CODE
CAIN A, -2 ;YES, IS RIGHT HALF = 777776?
JRST ENDST ;YES, PROCESS F4 END BLOCK
LDB B, [POINT 6,A,23];GET CODE BITS FROM BITS 18-23
TRZ A, 770000 ;THEN WIPE THEM OUT
CAIE B, 70 ;IS IT A DATA STATEMENT?
CAIN B, 50 ;IS IT ABSOLUTE MACHINE CODE?
JRST MACHCD ;YES, TREAT IT LIKE DATA STATEMENTS
CAIN B, 77 ;SPECIAL MANTIS DEBUGGER DATA?
JRST MACHCD ;YES, TREAT IT LIKE DATA
PUSHJ P,GETIN ;NO, ITS A LABEL OF SOME SORT
PUSHJ P, OUT4 ;WHICH CONSISTS OF ONE WORD
JRST F4 ;LOOK FOR NEXT BLOCK HEADER
MACHCD: HRRZ B, A ;GET THE WORD COUNT IN AC B
PUSHJ P,GETIN ;INPUT A WORD
PUSHJ P, OUT4 ;OUTPUT IT
SOJG B, MACHCD+1 ; LOOP BACK FOR REST OF THE BLOCK
JRST F4 ;GO LOOK FOR NEXT BLOCK
ENDST: MOVEI B,1 ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
MOVEI C,6 ;TO GO
F4LUP1: PUSHJ P,GETIN ;GET TABLE MEMBER
F4LUP3: PUSHJ P,OUT4 ;OUTPUT WORD
SOJGE B,F4LUP1 ;LOOP WITHIN A TABLE
JUMPL C,CPOPJ ;LAST TABLE - RETURN
SOJG C,F4LUP2 ;FIRST TWO WORDS AND FIVE TABLES
JUMPE C,F4LUP1 ;COMMON LENGTH WORD
F4LUP2: PUSHJ P,GETIN ;READ HEADER WORD
MOVE B,A ;COUNT TO COUNTER
JRST F4LUP3 ;STASH
OUT4: MOVE T1,A ;GET WORD INTO OUTPUT POSITION
TXNN F,F4IB ;DONT DO OUTPUT?
PUSHJ P,BOUT ;YES, DO OUTPUT
POPJ P, ;RETURN
SUBTTL ROUTINE TO DELETE LOCAL SYMBOLS FROM SYMBOL BLOCK
;ALL LOCAL AND SUPPRESSED LOCAL SYMBOLS ARE DELETED
;EXTERNALS,INTERNAL AND SUPPRESSED INTERNALS ARE NOT DELETED.
DELLOC: HRRZM A,BSZ ;SIZE OF SYMBOL BBLE
PUSHJ P,DELINI ;CLEAR NEW HEADER & RELOC WORDS
;SET PB = SYMBLK+2
DELGTR: PUSHJ P,GETIN ;GET RELOCATION WORD
MOVEM A,RELOCS ;SAVE IT
MOVE A,[POINT 4,RELOCS] ;INIT POINTER TO GET
MOVEM A,PTGRS ;RELOCATION WORD
DELGT1: PUSHJ P,GETIN ;GET FIRST WORD OF PAIR
ILDB B,PTGRS ;GET RELOCATION BITS & HOLD
TXNE A,R5.LCL ;IS SYMBOL LOCAL?
JRST DELDEC ;YES, DON'T COPY
MOVEM A,0(T) ;STORE FIRST WORD
PUSHJ P,GETIN ;GET SECOND WORD INTO A
MOVEM A,1(T) ;STORE SECOND WORD
IDPB B,PTSRS ;STORE RELOCATION BITS
MOVEI A,2 ;COUNT WORDS STORED
ADDM A,SYMBLK ;I.E. UPDATE WORD COUNT
ADDI T,2 ;UPDATE NEXT LOCATION TO STORE
MOVE A,PTSRS ;HAVE WE STORED 9
TLNN A,770000 ;SYMBOL PAIRS?
PUSHJ P,DELWRT ;YES, WRITE IT OUT
JRST DELDEC+1 ;ALREADY HAVE 2ND WORD
DELDEC: PUSHJ P,GETIN ;GET SECOND WORD INTO A
SOS BSZ ;HAVE WE EXHAUSTED
SOSG BSZ ;ALL WORDS IN BLOCK?
JRST DELFIN ;YES, NONE LEFT
MOVE A,PTGRS ;HAVE WE GOT 9
TLNE A,770000 ;SYMBOL PAIRS YET?
JRST DELGT1 ;NO, GET NEXT PAIR
JRST DELGTR ;YES, GET RELOCATION
DELFIN: PUSHJ P,DELWRT ;ORIGINAL BLOCK EMPTY NOW
JRST WRITE3 ;GET NEXT BLOCK
SUBTTL ROUTINE TO WRITE OUT NEW SYMBOL TABLE
DELWRT: SKIPN A,SYMBLK ;ANYTHING TO WRITE
JRST DELINI ;NO, CAN LEAVE
HRRZ C,A ;GET WORD COUNT
HRLI A,2 ;PUT IN BLOCK TYPE
MOVE T1,A ;INTO OUTPUT POSITION
PUSHJ P,BOUT ;WRITE BLOCK HEADER
MOVEI B,SYMBLK ;LOC OF FIRST WORD
DELWRU: ADDI B,1 ;LOC OF RELOC WORD
MOVE T1,0(B) ;GET WORD
PUSHJ P,BOUT ;OUTPUT
SOJGE C,DELWRU ;ALL THROUGH?
;ROUTINE TO INITIALIZE NEW SYMBOL TABLE
DELINI: SETZM SYMBLK ;YES, CLEAR COUNT
SETZM SYMBLK+1 ;CLEAR RELOCATION
MOVE A,[POINT 4,SYMBLK+1] ;INIT POINTER
MOVEM A,PTSRS ;FOR STORING NEW RELOC
MOVEI T,SYMBLK+2 ;SET TO STORE FIRST GLOBAL
POPJ P,
SUBTTL ROUTINES TO INDEX THE LIBRARY
COMMENT * THE INDEXING OF LIBRARY FILES IS DONE IN TWO PASSES.
ON PASS 1 THE LIBRARY FILE IS COPIED AND ALL ENTRIES STORED
IN CORE ALLONG WITH A POINTER TO THE BEGINING OF THE BLOCK.
A DUMMY INDEX BLOCK (TYPE 14) IS OUTPUT AT THE BEGINING OF THE
NEW LIBRARY AND ONE IS OUTPUT WHENEVER THE CURRENT INDEX BLOCK
FILLS A BUFFER.
ON PASS 2 THE DUMMY INDEX BLOCKS ARE REPLACED BY REAL ONES.
MAKLIB USED USETO'S AND DUMP MODE.
IF THE OUTPUT DEVICE IS DTA MAKLIB USES UGETF UUO'S TO FIND
THE NEXT BLOCK AND NON-STANDARD DUMP MODE TO WRITE THE INDICES.
DESIGN AND CODING BY D.M.NIXON JULY 1970
*
INDEX0: MOVE A,INDEXH ;BLOCK HEADER
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
AOS BLKCNT ;START ON BLOCK #1
MOVE T1,A
PUSHJ P,BOUT ;OUTPUT IT
OUTPUT OCHN, ;FORCE OUTPUT
MOVE T,OBUF+2 ;BUFFER SIZE
MOVEM T,XCOUNT
MOVEM T,BUFSIZ ;SAVE IT AWAY
AOS OBUF+2 ;COUNT IS OFF BY ONE BECAUSE OF OUT UUO
AOS T,.JBREL ;TO GET 1K MORE
MOVEM T,XPNTR
MOVEM T,XBEG ;START OF INDEX BUFFERS
CORE T,
JRST NECERR ;NOT ENUF CORE
MOVEI A,1 ;START ON BLOCK #1 (IF DSK)
MOVEM A,@XPNTR ;STORE FIRST BLOCK #
AOS XPNTR
MOVE A,INDEXH
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;RESERVE SPACE FOR NEXT LINK WORD
POPJ P, ;RETURN
;HERE ON PASS 1 TO STORE ENTRIES AND POINTERS.
INDEX1: AOS (P) ;SET SKIP RETURN
HRRZ T,ENTBLK ;GET SIZE OF BLOCK
JUMPE T,CPOPJ ;IF NO ENTRIES, JUST RETURN
MOVN A,T
ADDI T,1 ;WORD OF INFO
CAML T,XCOUNT ;ENUF ROOM IN BLOCK?
JRST NOROOM ;NO
MOVE T,ENTBLK ;GET HEADER WORD
MOVEM T,@XPNTR
AOS XPNTR
SOS XCOUNT
HRLS A
HRRI A,ENTBLK+1
INDEXA: SKIPN T,(A)
AOJA A,.-1
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
AOBJN A,INDEXA
INDEX2: MOVE T,BUFSIZ
SUB T,OBUF+2
HRLI T,1(T) ;WORD COUNT IS CORRECT FOR LOADER
HRR T,BLKCNT
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
POPJ P,
;HERE WHEN CURRENT INDEX BLOCK IS FULL.
NOROOM: MOVE A,INDEXH ;HEADER BLOCK OF INDEX FOR LOADER
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
MOVE T1,A
PUSHJ P,BOUTGO
OUTPUT OCHN,
AOS OBUF+2 ;COUNT IS OUT BY ONE BECAUSE OF OUTPUT UUO
MOVE T,BLKCNT ;GET INDEX BLOCK #
HRROM T,@XPNTR ;STORE IT WITH -1 IN LEFT HALF
MOVE A,XCOUNT ;PART OF BLOCK NOT FILLED
ADDB A,XPNTR ;START OF NEW BLOCK
ADD A,BUFSIZ ;ENSURE NEXT BUFFER WILL FIT IN CORE
CAMG A,.JBREL ;WILL IT?
JRST .+3 ;YES
CORE A, ;GET ENOUGH CORE
JRST NECERR ;NOT ENOUGH CORE
MOVE A,BUFSIZ
MOVEM A,XCOUNT
;MARK IT AS AN INDEX INCASE BLOCK FULL
HRROM T,@XPNTR ;SAVE BLOCK # FOR PASS 2
AOS XPNTR
TXNN F,DTAFLG ;NOT IF DTA
AOS BLKCNT ;ONE FOR OUTPUT
MOVE A,INDEXH
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;SPACE FOR LINK WORD TO NEXT INDEX
JRST INDEX1+1
;HERE FOR PASS 2. WRITE OUT THE INDEX BLOCKS
INDEX3: SETOM @XPNTR ;TERMINATE WITH END OF INDEX MARKER
OUTPUT OCHN, ;SO LAST BLOCK IS WRITTEN
TXNE F,DTAFLG ;IS IT DTA?
JRST INDEX5 ;YES, TREAT DIFFERENTLY
SETSTS OCHN,16
MOVNI A,200
HRLM A,XBEG
INDEX4: SETZM XBEG+1
MOVE A,@XBEG
USETO OCHN,(A)
OUTPUT OCHN,XBEG
STATZ OCHN,760000
JRST FSOERR ;FILE STATUS ERROR
MOVEI A,200
ADDB A,XBEG
HRRZS A
CAMG A,XPNTR
JRST INDEX4
JRST RSTRT
INDEX5: CLOSE OCHN, ;AND A SEPARATE EOF BLOCK
SETSTS OCHN,116 ;NON STANDARD MODE
MOVNI A,200 ;IOWD COUNT
HRLM A,XBEG ;SET IT UP FOR OUTPUT
USETI OCHN,@BLKCNT ;SET ON LAST BLOCK
INPUT OCHN,DIRIOW ;READ IT IN
LDB A,[POINT 10,DIRBLK,27] ;GET FIRST BLOCK #
HRRM A,@XBEG ;STORE IT FOR COMMON LOOP
SETZM XBEG+1 ;MAKE SURE IT'S ZERO
INDEX6: MOVE A,@XBEG ;GET BLOCK NUMBER
USETI OCHN,(A) ;SET FOR INPUT
INPUT OCHN,DIRIOW ;INPUT BLOCK
MOVE T,DIRBLK ;TO FIND LINK WORD
EXCH T,@XBEG ;PUT IT IN OUTPUT BLOCK
SOS XBEG ;BACK UP POINTER
USETO OCHN,(A) ;NOW FOR OUTPUT
OUTPUT OCHN,XBEG ;OUT IT GOES
STATZ OCHN,760000 ;UNLESS IN ERROR
JRST FSOERR ;FILE STATUS ERROR
MOVEI A,200 ;GET TO NEXT DUMP BLOCK
ADDB A,XBEG ;ADVANCE POINTER
HRRZS A ;JUST WORD LOCATION
CAMG A,XPNTR ;ALL DONE?
JRST INDEX6 ;NO, LOOP
SETSTS OCHN,16 ;BACK TO STANDARD MODE TO UPDATE DIR.
JRST RSTRT ;YES, FINISH UP
INDEXH: XWD 14,177 ;USED TO SIGNAL INDEX BLOCK TO LOADER
SUBTTL INPUT SERVICE ROUTINE
;THE INPUT ROUTINE GETS CHARACTERS FROM THE DEVICE WHOSE
;CHANNEL NUMBER IS IN ACCUMULATOR D. IT CALCULATES THE POSITION
;OF THE BUFFER HEADER OF THE DEVICE, THEN EITHER LOADS AC A
;FROM THE BYTE POINTER, OR DOES AN INPUT. IF AN END OF FILE
;IS FOUND, THE ROUTINE EXITS WITH A POPJ, SINCE THE READ ROUTINE
;IS CALLED WITH A PUSHJ, FOLLOWED BY AN EOF RETURN. THE NORMAL
;EXIT FROM GETIN IS BY A JRST @GETIN.
GETIN: SOSG @IBUF2 ;IS APPROPRIATE BUFFER EMPTY?
JRST INGET2 ;YES, GET ANOTHER BUFFER
GETIN1: ILDB A,@IBUF1 ;LOAD AC A WITH A CHARACTER
POPJ P,
; /BOUT/ - ROUTINE TO TAKE A BYTE FROM AC T1 AND PLACE IT
; IN THE CHANNEL OCHN. THE MODE IS PREDETERMINED AT
; OPEN TIME. THIS ROUTINE IS USED FOR BOTH ASCII AND BINARY
; OUTPUT.
;
BOUT: TXNE F,FOTTY ;IS SCAN IN COMMAND OF THE OUTPUT?
JRST [ OUTCHR T1 ;YES,DO TTCALL AND RETURN
POPJ P,] ;
SOSG OBUF+2 ;IS THERE ROOM IN THE BUFFER?
JRST BOUTGO ;NO,SO OUTPUT BUFFER
BOUT1: IDPB T1,OBUF+1 ;UNLOAD THE CHARACTER
TXNE F,DEVTTY ;IF OUTPUT IS TO TTY
CAIE T1,12 ;AND THIS IS LINEFEED
POPJ P, ;BUT ITS NOT,SO RETURN
OUTPUT OCHN, ;OUTPUT BUFFER
POPJ P, ;AND RETURN
BOUTGO: ;HERE TO UNLOAD BUFFER
TXNN F,XFLG ;CURRENTLY INDEXING?
JRST BOUTG1 ;NO,SKIP THIS
TXNN F,DTAFLG ;IF INDEXING TO DSK
AOSA BLKCNT ;INCREMENT COUNT, BUT FOR DECTAPE
UGETF OCHN,BLKCNT ;GET NEXT FREE BLOCK
BOUTG1: OUT OCHN, ;OUTPUT THE BUFFER
JRST BOUT1 ;DO UNLOAD THE CHARACTER/BYTE
JRST FSOERR ;SOME SORT OF ERROR ON THAT OUTPUT
SUBTTL GO UNDER IFN FTBPT CONDITIONAL THAT LASTS FOR MANY PAGES
IFN FTBPT,<
; /GETCOR/ - ROUTINE TO ALLOCATE FREE CORE
;
; INPUT- T1 CONTAINS THE NUMBER OF WORDS TO ALLOCATE
; OUTPUT- T1 CONTAINS THE FIRST WORD OF THE BLOCK ALLOCATED
;
; RETURNS- POPJ OR TO LABEL NECERR IF NO CORE AVAILABLE
;
GETCOR: SKIPG T1 ;CHECK OUR ARGUMENT
$STPCD(Negative amount of core requested)
PUSH P,.JBFF## ;SAVE ORIGINAL FFREE
ADDB T1,.JBFF## ;UPDATE THE CORE MARKER
SOS T1 ;BACK OFF ONE TO GET LAST WORD USED
CAMG T1,.JBREL## ;IN BOUNDS?
PJRST T1POPJ ;YES,RETURN WITH T1 CONTAINING ADDRESS
CORE T1, ;ELSE ALLOCATE THE CORE
JRST NECERR ;IF NO CORE AVAILABLE
PJRST T1POPJ ;RETURN, RESTORING T1 FROM
;ORIGINAL .JBFF
SUBTTL BIN- INPUT A BYTE IN ASCII FROM TRANSACTION FILE
;/BIN/ - ROUTINE TO GET A BYTE FROM INPUT (FIX FILE) AND LOAD
; IT INTO CC.
BIN: SOSG TBUF+2 ;ANYTHING IN THE BUFFER
PUSHJ P,BIN2 ;NO, GET ANOTHER
ILDB CC,TBUF+1 ;LOAD BYTE
JUMPE CC,BIN ;IGNORE NULLS
POPJ P, ;RETURN
BIN2: IN TRIN, ;GET A BUFFER
POPJ P, ;NO ERRORS,JUST RETURN
STATZ TRIN,IO.EOF ;EOF?
JRST FIX1 ;YES,TRAP TO EOF HANDLER
JRST FSTERR ;ERROR MESSAGE FOR OTHER ERROR STATUSES
SUBTTL MACLOD- ROUTINE TO GET A LINE OF MACRO CODE INTO MACBUF
; /MACLOD/- SINCE FOR ERROR PROCESSING AND FOR SYNTAX CHECKING
; IT IS USEFUL TO BE ABLE TO RESCAN MACRO CODE,
; THE PROCESSOR (EVAL) USES AN INPUT STREAM FROM AN INTERNAL
; BUFFER. MACLOD READS AN INPUT STREAM INTO THE MACRO CODE BUFFER
; "MACBUF"
;
; INPUTS- NONE
;
; OUTPUT- MACBUF IS LOADED WITH ASCIZ STRING OF MACRO CODE
; MACPTR IS A BYTE POINTER TO THIS STRING
; MACCNT IS THE COUNT OF CHARACTERS IN BUFFER,UP TO EOL
;
; RETURNS: ALWAYS CPOPJ
;
MACLOD: TXNE F,DEBIMC ;USING INTERNAL BUFFER?
POPJ P, ;YES,SO JUST RETURN
PUSH P,T1 ;SAVE REGISTER T1
SETZM MACCNT ;RESET COUNT
MOVE T1,[POINT 7,MACBUF] ;SET UP POINTER
MOVEM T1,MACPTR ;SAVE IT FOR RE-READS
;**;[25] MACLOD+5 ILG 9-JUL-76
PUSHJ P,BIN ;[25]INSURE BUFFER IS SET UP
MOVE T1,@TBUF+1 ;[25]GET CURRENT WORD
TRNE T1,1 ;[25]CHECK FOR LSN BIT
AOS MACPTR ;[25]GOT LSN. SKIP THE WORD
SKIPA T1,[POINT 7,MACBUF] ;[25]RESTORE T1,SKIP THE LOAD CHAR
MACLD1: PUSHJ P,BIN ;GET CHARACTER
IDPB CC,T1 ;DEPOSIT CHARACTER
AOS MACCNT ;UPDATE COUNT
SKIPE MACLST ;NOT INTO SAFETY WORD,ARE WE?
JRST MACLD2 ;YES,ERROR
CAIL CC,12 ;WATCH FOR END OF LINE
CAILE CC,14 ;ITS OUR DELIMITER
JRST MACLD1 ;NOT END OF LINE,GET NEXT CHARACTER
SETZ CC, ;DEPOSIT NULL AFTER LINE
IDPB CC,T1 ;FOR ERROR MESSAGES
POP P,T1 ;RESTORE T1
AOS LLOFF ;LINES SINCE LAST LABEL
POPJ P, ;RETURN
MACLD2: MOVEI CC,.CHLFD ;FINISH LINE WITH BREAK
IDPB CC,T1 ;SO ERROR MESSAGE IS GOOD
$KILL(LTL,MACRO code line is too long,,$MORE)
JRST MCCOMM ;CONTINUE WITH ERROR
SUBTTL MIC - ROUTINE TO LOAD CHARACTER (AND EDIT IT) FROM MACRO CODE BUFFER
; /MIC/ - THIS ROUTINE READS CHARACTERS FROM THE BUFFER "MACBUF"
; POINTED TO BY MACPTR. A COUNT IS DECREMENTED , AND CHECKED
; OF CHARACTERS LEFT, AND IF NOT EXHAUSTED, A CHARACTER
; IS LOADED. THE FLAG, "REGET" IS TESTED AND READ ALSO.
;
; SOME EDITTING OF THE CHARACTERS IS DONE ALSO.
;
MIC: TXZN F,REGET ;IS REGET OF CHARACTER ON?
PUSHJ P,MIC5 ;NO,LOAD CHARACTER
CAIL CC,12 ;CONVERT END-OF-LINE
CAILE CC,14 ;TO $EOL
CAIA
JRST [ MOVEM CC,REOL ;SAVE "REAL" END OF LINE
MOVEI CC,$EOL ;AND REPLACE WITH FAKE ONE
JRST .+1 ] ;AND CONTINUE
TXNE F,QUOTE ;CONVERION SUPRESSED?
POPJ P, ;YES,SO JUST RETURN
CAIN CC," " ;CONVERT <TAB>
MOVEI CC," " ;TO <SPACE>
CAIL CC,"a" ;LOWER CASE LETTER?
SUBI CC,"a"-"A" ;YES,CONVERT
CAIE CC,$EOL ;END OF LINE OR
CAIL CC," " ;NOT LESS THAN BLANK
POPJ P, ;JUST RETURN
JRST MIC ;ELSE LOAD ANOTHER CHARACTER
MIC5: SOSGE MACCNT ;DONT LET CHARACTER COUNT GO NEGATIVE
$STPCD(MACRO evaluator read past its end of buffer)
ILDB CC,MACPTR ;LOAD CHARACTER
POPJ P, ;RETURN TO CALLER
SUBTTL ROUTINES TO MANIPULATE THE MACRO CODE BUFFER
; /MACPEK/- ROUTINE TO RETURN THE CHARACTER AFTER THE NEXT ONE
;
; INPUT- NONE
; OUTPUT- AC A WILL CONTAIN THE CHARACTER AFTER THE CURRENT ONE
; IE. CHARACTER NEXT ILDB WILL GET
;
MACPEK: PUSH P,T1 ;SAVE T1
MOVE T1,MACPTR ;GET THE POINTER
ILDB A,T1 ;GET CHARACTER
CAIL A,"a" ;[24]CHARACTER LESS THAN LC "A"?
CAILE A,"z" ;[24]NO, SO IS IT LESS THAN LC "Z"?
SKIPA ;[24]NOT IN RANGE LC A-Z
SUBI A,"a"-"A" ;[24]ELSE CONVERT TO UPPER CASE
PJRST T1POPJ ;RESTORE AND RETURN
; /MACSAV/ AND /MACRST/ - ROUTINES TO SAVE AND RESTORE THE STATE OF
; THE BUFFER POINTER AND COUNT.
;
; MACSAV- SAVES AWAY THE COUNT AND POINTER WORDS
; MACRST- RESTORES COUNT AND POINTER FROM LAST CALL TO MACSAV
;
MACSAV: PUSH P,MACPTR ;GET POINTER
POP P,MACSV1 ;STORE IT
PUSH P,MACCNT ;GET COUNT
POP P,MACSV2 ;SAVE IT ALSO
POPJ P, ;RETURN
MACRST: PUSH P,MACSV1 ;GET POINTER
POP P,MACPTR ;RESTORE IT
PUSH P,MACSV2 ;GET COUNT
POP P,MACCNT ;RESTORE IT
TXZ F,REGET ;INVALIDATE ANY REGET
POPJ P, ;RETURN
SUBTTL ROUTINE TO BACK UP THE REL FILE
;/BACKUP/ - THIS ROUTINE CLOSES THE MASTER AND OUTPUT FILES. IT THEN
; OPENS AS THE NEW MASTER THE OLD OUTPUT.
; IT THEN ENTERS AS NEW OUTPUT A NEW FILE WITH
; THE SAME NAME AS THE OLD OUTPUT. THIS HAS THE EFFECT
; OF BACKING US UP INTO WHAT WAS THE OLD MASTER WITHOUT
; ACTUALLY DESTROYING THE OLD MASTER.
BACKUP: PUSHJ P,COPY ;INSURE THAT ALL DONE
CLOSE MIN, ;CLOSE OMASTER
STATZ MIN,760000 ;CHECK FOR ERRORS
JRST FSMERR
RELEAS MIN,
CLOSE OCHN, ;CLOSE OUTPUT
STATZ OCHN,760000 ;
JRST FSOERR ;
RELEASE OCHN,
MOVE T1,[XWD BCKBLK,OPNBLK] ;RESTORE OUTPUT SPECS
BLT T1,OPNBLK+<.RBSIZ+2+3>-1 ;FOR RE-OPENS
MOVE T1,BCKFF ;RESTORE CORE MARKER
EXCH T1,.JBFF## ;
MOVEM T1,BCKFF+1 ;SO WE DONT SWELL
OPEN OCHN,OPNBLK ;OPEN OUTPUT
JRST OPNFAI ;
ENTER OCHN,LKPBLK ;ENTER IT
JRST LKPFAI ;
OUTBUF OCHN, ;SET UP BUFFER
MOVE T1,[BCKBLK,,OPNBLK] ;RESTORE SPECS AGAIN
BLT T1,OPNBLK+<.RBSIZ+2+3>-1 ;
MOVEI T1,MBUF ;CORRECT HEADER POINTER
MOVEM T1,OPNBLK+2 ;
OPEN MIN,OPNBLK ;OPEN MASTER FOR INPUT AGAIN
JRST OPNFAI
LOOKUP MIN,LKPBLK ;AND LOOKUP
JRST LKPFAI
INBUF MIN,
MOVE T1,BCKFF+1 ;RESTORE FIRST FREE
MOVEM T1,.JBFF## ;DONE
POPJ P, ;RETURN
SUBTTL OCTIN,DECIN,CRADIN - ROUTINES TO DO NUMERIC INPUT FROM FIX FILE
; /DECIN/ - ROUTINE TO INPUT A DECIMAL (10.) NUMBER FROM
; FIX FILE INTO AC A.
; /OCTIN/ - SAME AS ABOVE, OCTAL (8.)
; /CRADIN/ - READ NUMBER IN USING VALUE IN LOCATION
; CRADIX AS THE CURRENT RADIX.
;
; DELIMITER IS LEFT IN CC. IT IS THE FIRST NON-DIGIT (0-9) ENCOUNTERED.
; IF A DIGIT GREATER THAN THE CURRENT RADIX IS FOUND, THE INPUT
; IS AUTOMATICALLY CHANGED TO RADIX10.
;
OCTIN: SKIPA T,[^D8] ;FOR BASE 8 INPUT
DECIN: MOVEI T,^D10 ;FOR DECIMAL
SKIPA ;RADIX LOADED
CRADIN: MOVE T,CRADIX ;T IS LOADED WITH CURRENT RADIX
SETZ A, ;CLEAR RESULT
SETZM DECNUM ;CLEAR FORCED RADIX 10 NUMBER
RADI1: PUSHJ P,MIC ;GET A CHARACTER
SKPNUM ;IS IT A DIGIT?
POPJ P, ;NO,SO RETURN
SUBI CC,"0" ;CONVERT TO NUMBER
CAMGE CC,T ;OVER OR AT CURRENT RADIX?
JRST RADI2 ;NO, LEAVE IT ALONE
MOVEI T,^D10 ;CONVERT TO RADIX 10
MOVE A,DECNUM ;GET WHAT WE HAVE READ IN SO FAR
RADI2: IMULI A,(T) ;SHIFT OVER
ADDI A,0(CC) ;
EXCH A,DECNUM ;MAKE RADIX10 NUMBER
IMULI A,^D10
ADDI A,0(CC) ;
EXCH A,DECNUM ;
JRST RADI1 ;AND GO BACK FOR NEXT
SUBTTL SYMIN - ROUTINE TO FORM A SYMBOL FROM THE INPUT STREAM
;/SYMIN/ - THIS ROUTINE LOADS CHARACTERS INTO AC A FORMING A
; SYMBOL THAT IS LEFT JUSTIFIED. THE SYMBOL IS DELIMITED
; BY THE FIRST CHARACTER NOT IN THE RADIX-50 CHARACTER
; SET.
; THE DELIMITING CHARACTER IS LEFT IN AC CC. THE SYMBOL
; IS LEFT IN SIXBIT FORM. THE DELIMITER IS IN ASCII
; CHARACTERS IN EXCESS OF THE MAX. OF 6 ARE EATEN AND DISCARDED.
;
SYMIN: SETZM A ;START WITH NO SYMBOL
PUSH P,T1 ;SAVE T1
MOVE T1,[POINT 6,A] ;AND GIVE IT A POINTER TO A
SYMIN1: PUSHJ P,MIC ;READ A CHAR FROM PATCH FILE
SKPR50 ;IS IT RADIX50?
JRST T1POPJ ;NO,SO RETURN,RESTORING T1
SYMIN2: TRNE A,77 ;HAVE WE GOT ROOM?
JRST SYMIN1 ;NO,JUST DISCARD CHARACTER
SUBI CC,40 ;CONVERT TO SIXBIT
ANDI CC,77 ;FOR SYMBOL STORAGE
IDPB CC,T1 ;AND INCLUDE CHARACTER
JRST SYMIN1 ;GET NEXT CHARACTER
; /TDIGIT/- ROUTINE TO TEST IF CHARACTER IN AC CC IS A VALID DIGIT (0-9)
;
; SKIP RETURN IF DIGIT, NON-SKIP IF NOT
;
TDIGIT: CAIL CC,"0" ;LESS THAN 0?
CAILE CC,"9" ;.GT. 9?
POPJ P, ;NOT DIGIT
PJRST CPOPJ1 ;DIGIT
; /TABC/ - ROUTINE TO TEST IF CHARACTER IS IN THE RANGE OF A-Z
;
; SKIP IF CHARACTER IS ALPHABETIC, NON-SKIP IF IT ISN'T
;
TABC: CAIL CC,"A" ;LESS THAN 'A'?
CAILE CC,"Z" ;OR GREATER THAN 'Z'?
POPJ P, ;YES, SO NOT ALPHABETIC
JRST CPOPJ1 ;ELSE TAKE ALPHABETIC RETURN
;/TR50/ - ROUTINE TO TEST IF A CHARACTER IS IN THE RADIX50 SET.
;
;
TR50: PUSHJ P,TDIGIT ;NUMBERS ARE
CAIN CC,"." ;AND SO ARE PERIODS
JRST CPOPJ1 ;SO TAKE GOOD RETURN
PUSHJ P,TABC ;ALPHABETIC IS LEGAL
CAIN CC,"$" ;AS IS DOLLAR SIGN
JRST CPOPJ1 ;SO TAKE GOOD RETURN
CAIN CC,"%" ;CHECK PERCENT SIGN
JRST CPOPJ1
POPJ P, ;NOT IN 0-9,A-Z,$,%,.
SUBTTL DESCRIPTION OF INTERIM SYMBOL TABLE (IST)
COMMENT \
THE INTERIM SYMBOL TABLE (IST) CONTAINS PAIRS OF WORDS
THAT DESCRIBE ACTIONS TO BE TAKEN FOR FIXING UP FORWARD REFERENCES TO
SYMBOLS, EXTERNALS AND LITERALS.
THE IST IS ALSO USED FOR ASCII,ASCIZ AND SIXBIT STRINGS THAT
EXTEND FOR MORE THAN ONE WORD.
WHEN EVAL FINDS A SYMBOL THAT IS UNDEFINED:
1) SET OPERAND RESULT (AC A) TO 0
2) SET SYMBOL FIXUP POINTER (AC C) TO BE POINTER TO ENTRY IN IST
3) SET IST WORD 1 TO BE SIXBIT THIS SYMBOL NAME
4) SET 2ND WORD OF IST PAIR TO IS.UDF, ALSO IS.DER IFF SYMBOL FOLLOWED BY ##
ALSO, RELOC IS CLEARED IF EXTERNAL.
5) THE RELOC AND SYMBOL FIXUP ARE CARRIED THRU ALL LATER OPERATIONS
6) AT THE END OF EVAL, THE RH OF IST ENTRY WORD 2 IS REVERSED TO POINT
BACK AT THE LOCATION THAT CODE WORD IS STORED IN.
8) WHEN SYMBOL IS RESOLVED, ITS VALUE IS STORED INTO THE APPROPRIATE
HALF OF THE WORD.
WHEN EVAL FINDS A REFERENCE TO AN EXTERNAL:
1) RESULT,RELOCATABILTY ARE SET TO 0.
2) SYMFIX (AC C ) IS SET TO POINT TO FIRST FREE IST PAIR
3) WORD 1 OF PAIR GETS SIXBIT SYMBOL NAME
4) WORD 2 GETS FLAG OF IS.DER (DEFFERED EXTERNAL REFERENCE)
5) OPERAND IS CARRIED THRU LATER OPERATIONS
6) AT END OF EVAL, POINTER IS REVERSED TO INDICATE FIXUP ADDRESS
7) IF ALL GOES WELL, A SYMBOL TABLE ENTRY IS MADE LATER TO HOOK
REQUEST INTO GLOBAL CHAIN.
WHEN EVAL FINDS A REFERENCE TO AN LITERAL:
1) THE EXPRESSION WITHIN BRACKETS IS EVALUATED.
A LINKED LIST OF WORDS IS FORMED FOR THE LITERAL.
1A) THE EXPRESSION RESULT,ITS RELOC AND SYMFIX ARE STORED IN
FREE CORE AS A LINKED LIST
2) A POINTER TO THE LINKED LIST IS PUT INTO THE FIRST WORD OF THE IST PAIR
4) RESULT IS SET TO 0, RELOC TO RH ONLY (1), SYMFIX (AC C) IS SET TO
POINT BACK AT THE IST PAIR. FLAG (AC D) IS SET TO C.LIT
5) THE OPERAND IS PASSED BACK FOR FURTHER USE.
6) AT THE END, THE LITERAL WORD IS TO BE INSERTED WITH APPROPRIATE
RELOCATION AND THEN THE POINTER IS USED TO DUE THE NORMAL FIXUP.
WHEN EVAL FINDS THAT A STRING EXTENDS FOR MORE THAN ONE WORD:
1) THE FIRST WORD OF THE STRING IS LEFT ALONE
2) AN IST PAIR ENTRY IS MADE. THE FIRST WORD IS:
XWD -COUNT OF WORDS, ADDRESS OF STRING
3) THE EXCESS WORDS ARE GENERATED INTO FREE CORE (THAT WORD 1 OF IST PAIR
POINTS TO)
4) THE USUAL STUFF IS DONE WITH IST POINTER CARRIED AROUND BY THE
EXPRESSION AND REVERSED AT EXIT FROM EVAL.
THE SECOND WORD OF THE IST IS THEN: IS.MWS,,ADDRESS 1ST WORD GENERATED INTO
5) AT FIXUP TIME, THE STRING IS GENERATED.
\
; FLAGS IN LH OF WORD TWO OF IST PAIR
$1BIT=1B17 ;LEAVE RH FREE
BIT(IS.UDF) ;THIS SYMBOL IS NOT IN SYMBOL TABLE
BIT(IS.DEF) ;THIS WAS REQUEST TO DEFINE SYMBOL (SINGLE #)
BIT(IS.LH) ;THIS FIXUP IS TO LEFT HALF OF WORD
BIT(IS.FW) ;THIS IS OK AS A FULLWORD FIXUP
BIT(IS.DER) ;THIS IS A DEFERRED EXTERNAL REQUEST
BIT(IS.NEG) ;THIS IS A REQUEST TO SUBTRACT
BIT(IS.LIT) ;THIS IS A PSEUDO-LITERAL
BIT(IS.MWS) ;THIS IS THE CONTINUANCE OF A MULTI-WORD STRING
BIT(IS.BLK) ;THIS IS A BLOCK FORM OF IS.MWS
BIT(IS.GEN) ;OK TO GENERATE FIXUP NOW
SUBTTL ROUTINES FOR MANIPULATING THE IST (INTERIM SYMBOL TABLE)
; /ISTINI/- ROUTINE TO ZERO THE IST MAP
;
ISTINI: PUSH P,T1 ;SAVE T1
MOVE T1,[XWD ISTMAP,ISTMAP+1]
SETZM ISTMAP
BLT T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ
; /ISTGET/ - ROUTINE TO FIND THE FIRST AVAILABLE SLOT ON THE IST
;
; THIS ROUTINE IS USED FOR ALLOCATING A SLOT IN THE INTERIM SYMBOL TABLE
;
; INPUTS-NONE
;
; OUTPUTS- AC C WILL CONTAIN THE ADDRESS OF THE SLOT IN THE IST
; OR THE FATAL ERROR MESSAGE FOR ROOM EXHAUSTED IS GIVEN
;
; RETURNS- ALWAYS POPJ, OR TO ERROR PROCESSOR
;
ISTGET: PUSH P,T1 ;SAVE T1-2
PUSH P,T2
MOVE T1,[POINT 1,ISTMAP] ;POINTER TO BIT MAP
MOVEI C,IST ;INITIAL GUESS AS TO FREE SLOT
ISTGE1: ILDB T2,T1 ;GET BIT
JUMPE T2,[ SETOM T2 ;MARK AS IN USE
DPB T2,T1 ;
PJRST T2POPJ ] ;AND RETURN
ADDI C,2 ;NOT THIS PAIR
CAIG C,ISTLST ;OVER THE END?
JRST ISTGE1 ;NO
$KILL(IST,<Interim symbol table overflowed, Code too complex in edit>,N$SIX)
; /ISTVAL/ - ROUTINE TO SEE IF PARTICULAR PAIR OF IST IS IN USE
;
; INPUT- AC T1 CONTAINS POINTER TO PAIR IN IST
; OUTPUT - AC T1 IS PRESERVED
;
; RETURNS - CPOPJ= PAIR IS NOT IN USE
; CPOPJ1 = PAIR IS IN USE
;
ISTVAL: PUSH P,T1 ;SAVE INPUT ARG
PUSH P,T2
SUBI T1,IST ;MAKE INDEX
LSH T1,-1 ;TWO WORDS PER PAIR
MOVE T2,[POINT 1,ISTMAP] ;
IBP T2 ;ADJUST BYTE POINTER
SOJGE T1,.-1
LDB T2,T2
SKIPE T2 ;IF IN USE
AOS -2(P) ;UPDATE TO BE SKIP RETURN
PJRST T2POPJ ;RETURN , RESTORE THE ACS
;
; /ISTSAV/ & /ISTRST/ - ROUTINE TO SAVE AND RESTORE THE STATE OF
; THE IST SO THAT UPON ERRORS AND CODE COMPARE, WE CAN DE-ALLOCATE
; IST SPACE TEMPORARILY USED.
;
ISTSAV: PUSH P,T1 ;SAVE T1
MOVE T1,[XWD ISTMAP,ISTALT] ;
BLT T1,ISTALT+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ ;RESTORE T1,RETURN
ISTRST: PUSH P,T1 ;SAVE T1
MOVS T1,[XWD ISTMAP,ISTALT]
BLT T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ ;RESTORE,RETURN
SUBTTL ROUTINES TO DO POST-FIXUPS FOR THE INTERIM SYMBOL TABLE
; THE FOLLOWING ROUTINES REMOVE ENTRIES FROM THE INTERIM FIXUP TABLE
; WHEN THINGS ARE DEFINED. THINGS DEFINED INCLUDE EXTERNAL AND LOCAL FIXUPS
; LITERAL AND STRING CONTINUATION FIXUPS.
;
; /PMLOC/ - ROUTINE TO REMOVE ENTRIES FROM THE IST REFERRING TO
; A LOCAL SYMBOL (LABEL)
;
; INPUTS- NONE
;
; OUTPUTS- IF THERE ARE FORWARD REFERENCES, THEY ARE REMOVED,FIXED UP
; AND THE IST IS COLLAPSED.
;
; RETURNS- ALWAYS CPOPJ
;
PMLOC: MOVEI T1,ISTLST+1 ;GET POINTER TO NON-EXISTENT PAIR
PMLOC1: CAIN T1,IST ;ARE WE AT FRONT OF TABLE?
POPJ P, ;YES , RETURN
SUBI T1,2 ;ADJ TO POINT TO CURRENT ENTRY
MOVE T2,1(T1) ;FETCH FLAG,,ADDR
TXNE T2,IS.GEN ;ADDRESS AVAILABLE TO FIXUP?
TXNE T2,IS.LIT!IS.DER!IS.MWS!IS.DEF ;IGNORE IF NOT LOCAL SYMBOL FIXUP
JRST PMLOC1
PUSHJ P,ISTVAL ;SEE IF VALID
JRST PMLOC1 ;ITS NOT
MOVE R,0(T1) ;GET THE SYMBOL NAME
PUSHJ P,SYMSRC ;LOOKUP THE SYMBOL
JRST PMLOC1 ;NOT DEFINED YET
MOVE T2,A ; LOAD T2 WITH SYMBOL VALUE
MOVE T3,D ;T3 GETS RELOCATION
MOVE T4,1(T1) ;GET FLAG WORD AGAIN
TXNN T4,IS.LH ;MAKE CHECK IF LH FIXUP
TXNN T4,IS.FW ;SKIP CHECK IF FULL WORD
JRST [ TLNE T2,-1 ;INSURE NULL LH
TLC T2,-1 ;TRY MAKING HALFWORD NEGATIVES
TLNE T2,-1 ;
TLZ T2,-1 ;JUST TRUNCATE IT THEN
JRST .+1 ] ;
PUSHJ P,PMFIX ;PATCH REL FILE,COLLAPSE IST
JRST PMLOC1 ;AND RE-ITERATE
; /PMDEF/ - ROUTINE TO DEFINE A LOCAL SYMBOL BEFORE IT CAN BE FIXED UP
; PMDEF IS CALLED FOR SYMBOLS WHICH ARE UNDEFINED AND WERE FOLLOWED
; BY '#' WHEN REFERENCED. A LOCAL VARIABLE IS DEFINED IN THE LOW
; SEG VIA THE MACRO BLOCK TYPE MECHANISM AND THEN THE IS.DEF BIT
; IS TURNED OFF, ALLOWING THE ROUTINE PMLOC TO RESOLVE ALL FIXUPS
; FOR THIS SYMBOL
; INPUT - IST ENTRY OF THE FORM: 1/SYMBOL NAME IN SIXBIT
; 2/IS.DEF!IS.UDF,,0 OR ADDRESS TO FIXUP
; RETURNS WITH CPOPJ ALWAYS
PMDEF: MOVEI T1,ISTLST+1 ;GET POINTER TO NON-EXISTENT PAIR
PMDEF1: CAIN T1,IST ;ARE WE DONE?
POPJ P, ;YES, SO RETURN NOW
SUBI T1,2 ;BACK DOWN ONE PAIR
MOVE T2,1(T1) ;GET THE FLAGS FOR THIS ONE
TXNE T2,IS.DEF ;WANT TO DEFINE VARIABLE?
PUSHJ P,ISTVAL ;AND ITS CURRENTLY VALID?
JRST PMDEF1 ;ONE OR THE OTHER NOT TRUE
MOVEI T3,SEB+2 ;ASSUME NO HIGH SEGMENT
SKIPE HSILOC ;IS THERE ONE?
AOS T3 ;YES, SO END BLOCK HAS DIFFERENT FORM
MOVE R,0(T1) ;GET SYMBOL NAME
PUSHJ P,SYMSRC ;MAKE SURE ITS UNDEFINED
SKIPA ;TO PREVENT XWD FOO#,FOO#
JRST MERROR ;COMPLAIN IF NOT UNDEFINED
HRRZ A,0(T3) ;GET BREAK FROM END BLOCK
AOS 0(T3) ;AND UPDATE THE END BLOCK
MOVEI B,1 ;RELOCATABLE ADDRESS
PUSHJ P,RAD50 ;CONVERT SYMBOL TO RADIX 50
PUSHJ P,NEWSYM ;REGISTER THE SYMBOL
JRST STOERR ;OUT OF ROOM
MOVX A,IS.DEF ;TURN OFF THE DEFINE BIT
ANDCAM A,1(T1) ;SO PMLOC WONT IGNORE IT
PUSH P,T1 ;SAVE INDEX
PUSHJ P,PMLOC ;ALLOW PMLOC TO DO THE FIXUP
POP P,T1 ;RESTORE INDEX
JRST PMDEF1 ;AND CONTINUE
; /PMLIT/ - ROUTINE TO GENERATE LITERAL WORDS AND TO
; DO THE FIXUP NECESSARY SINCE LITERALS ARE FORWARD REFERENCES
; INPUT- IST PTR TO CHAIN OF LITERAL BLOCKS
; OUTPUTS - APPROPRIATE WORDS OF CODE AND COLLAPSED IST
; NOTE: DO NOT CHANGE BACK TO FRONT SWEEP OF IST FOR LITERAL FIXUPS.
; THIS WILL BREAK NESTED LITERALS.
; RETURNS- ALWAYS CPOPJ
;
PMLIT: MOVEI T1,ISTLST+1 ;GET POINTER TO NON-EXISTENT PAIR
PMLIT1: CAIN T1,IST ;AT FRONT?
POPJ P, ;YES,SO RETURN
SUBI T1,2 ;BACK UP OVER PAIR
MOVE T2,1(T1) ;GET FLAGS,,FIXUP DESTINATION
TXNE T2,IS.GEN ;IF NOT READY YET OR
TXNN T2,IS.LIT ;NOT A LITERAL
JRST PMLIT1 ;JUST IGNORE
PUSHJ P,ISTVAL ;VALID?
JRST PMLIT1 ;NO,SO SKIP IT
MOVE A,0(T1) ;GET ADDRESS OF CODE TRIPLET
PUSH P,CPADDR ;SAVE ADDRESS OF START OF LITERAL
PMLIT2: MOVE C,0(A) ;LOAD WORD OF CODE
MOVE B,1(A) ;GET RELOCATION WORD
TLNE B,1 ;IS LEFT HALF RELOCATED?
TRO B,1B34 ;YES,SO FLAG IT SO
HRRZS B ;
MOVE T2,CPADDR ;GET ADDRESS THIS WORD WILL GO TO
TXO T2,IS.GEN ;FLAG THAT WORD IS GENERATED
HRRZ D,2(A) ;GET RIGHT HALF OF SYMBOL FIXUP WORD
JUMPE D,.+2 ;IF 0,NO RH FIXUP REQUIRED
IORM T2,1(D) ;FIXUP NEEDED, DEPOSIT ADDRESS
HLRZ D,2(A) ;DO THE SAME FOR THE LEFT HALF
JUMPE D,.+3
TXO T2,IS.LH ;FLAG AS LEFT HALF FIXUP
IORM T2,1(D) ;DEPOSIT ADDRESS AND FLAG
HRRZS T2
PUSH P,3(A) ;SAVE LINK WORD
PUSHJ P,NEWCODE ;INSERT THE CODE
JRST INSERR
PUSH P,T1 ;PRESERVE T1
PUSHJ P,PMMWS ;SEE IF MORE TO FOLLOW
POP P,T1 ;RESTORE T1
POP P,A ;RESTORE LITERAL LINK
JUMPN A,PMLIT2 ;IF NON-ZERO, FOLLOW IT
POP P,T2 ;T2 GETS ADDRESS OF LITERAL
SETZ T3, ;RELOC IS ALREADY SET
PUSHJ P,PMFIX ;DO THE FIXUP
PUSH P,T1 ;INVOKE LOCAL AND EXTERNAL FIXUPS
PUSHJ P,PMLOC ;SINCE FIXUP IS DEFERRED UNTIL
PUSHJ P,PMEXT ;LITERAL ACTUALLY GENERATED
POP P,T1 ;RESTORE CURRENT IST POINTER
JRST PMLIT1 ;AND RE-ITERATE
; /PMEXT/ - ROUTINE TO REMOVE EXTERNAL REFERENCES FROM THE IST
;
; INPUTS- NONE
;
; OUTPUTS- PROGRAM SYMBOL TABLE IS UPDATED TO MAKE REQUEST AND THE
; IST IS COLLAPSED.
;
; NOTE THAT EXTERNAL REFERENCES IN PATCH CODE ARE ALWAYS ADDED USING
; AN ADDITIVE GLOBAL REQUEST (LINK TYPE 2) OF FORM:
; 1ST WORD / 60 RADIX50-NAME
; 2ND WORD/ 1B0+(POSSIBLY 1B1)+ADDRESS OF REQUEST
;
; 1B1 IS ON FOR LEFT HALF FIXUP, OFF IF FIXUP IS TO RIGHT HALF
;
; RETURNS- ALWAYS CPOPJ
;
PMEXT: MOVEI T1,ISTLST+1 ;GET POINTER TO NON-EXISTENT PAIR
PMEXT1: CAIN T1,IST ;AT FRONT?
POPJ P, ;YES,SO RETURN
SUBI T1,2 ;BACK OVER THE FRAME
MOVE T2,1(T1) ;PICK UP FLAG WORD,,ADDRESS OF REQUESTING WORD
TXNE T2,IS.GEN ;WORD HAS BEEN GENERATED AND
TXNN T2,IS.DER ;THIS IS A REQUEST, RIGHT?
JRST PMEXT1 ;NO,SO SKIP IT
PUSHJ P,ISTVAL ;CHECK FOR EMPTINESS
JRST PMEXT1 ;EMPTY,SO SKIP IT
MOVE R,0(T1) ;GET SYMBOL NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
HRRZ A,T2 ;GET ADDRESS OF FIXUP
TXO A,R5.FXA ;INDICATE ADDITIVE GLOBAL
TXNE T2,IS.LH ;IS REQUEST TO LEFT HALF?
TXO A,R5.FXL ;YES,INDICATE SO
MOVEI B,1 ;RELOCATE PTR TO FIXUP
PUSHJ P,GLRSYM ;ADD GLOBAL REQUEST SYMBOL
JRST STOERR ;IF NO ROOM LEFT
PUSHJ P,PMFIX1 ;COLLAPSE INTERIM TABLE
JRST PMEXT1 ;AND CONTINUE
; /PMMWS/ - ROUTINE TO GENERATE 2ND THRU NTH WORDS OF MULTI-WORD STRING
; ALSO DOES MULTIPLE WORD GENERATION FOR THE "BLOCK" PSEUDO-OP
;
; INPUTS- IST ENTRY OF FORMAT:
; 1/ AOBJN PTR TO STRING OR -COUNT,,0 FOR BLOCK PSEUDO OP
; 2/ IS.MWS,,ADDRESS THAT 1ST WORD OF STRING OR BLOCK WENT INTO.
; OR IS.MWS!IS.BLK,,ADDRESS THAT FIRST WORD OF BLOCK WENT INTO
;
; OUTPUTS- 2ND THRU NTH WORD GENERATED
;
; RETURNS- ALWAYS CPOPJ
;
PMMWS: MOVEI T1,ISTLST+1 ;GET POINTER TO NON-EXISTENT PAIR
PMMWS1: CAIN T1,IST ;ALL DONE?
POPJ P, ;YES,RETURN
SUBI T1,2 ;GET TO FRONT OF PAIR
MOVE T2,1(T1) ;GET SECOND WORD OF PAIR
TXNE T2,IS.GEN ;IF WORD NOT GENERATED YET
TXNN T2,IS.MWS ;OR NOT STRING
JRST PMMWS1 ;IGNORE THE ENTRY
PUSHJ P,ISTVAL ;
JRST PMMWS1 ;IGNORE NULL ENTRIES
MOVE T3,CPADDR ;ELSE CONFIRM THAT WE
CAIE T3,1(T2) ;CAN GENERATE INTO PROPER PLACE
$STPCD(Multiple word generator called at wrong time)
MOVE T4,0(T1) ;GET AOBJN POINTER
PMMWS2: TXNE T2,IS.BLK ;IS THIS FOR BLOCK OPERATOR?
TDZA C,C ;YES,GENERATE A WORD OF ZEROS
MOVE C,0(T4) ;ELSE LOAD WORD OF STRING
SETZ B, ;WITH NO RELOCATION
PUSHJ P,NEWCOD ;GENERATE INTO MODULE
JRST INSERR
AOBJN T4,PMMWS2 ;LOOP FOR ALL WORDS
PUSHJ P,PMFIX1 ;REMOVE ENTRY FROM IST
JRST PMMWS1 ;SEE IF MORE IS.MWS ENTRIES
; /PMFIX/ -PATCH A VALUE AND RELOCATION INTO THE REL FILE
; /PMFIX1/ - REMOVE AN ENTRY FROM THE IST
;
; NOTE THAT A CALL TO PMFIX GENERATES ONE TO PMFIX1
;
; INPUTS- AC T1 SHOULD CONTAIN PTR TO WORD 1 OF CURRENT IST PAIR
; AC T2 SHOULD CONTAIN THE VALUE OF TOKEN BEING FIXED UP
; AC T3 SHOULD CONTAIN IN BITS 34-35 A TWO BIT RELOCATION TO
; 'OR' IN WITH EXISTING BITS
;
; OUTPUTS- ACS T1 & T2 ARE PRESERVED
; THE ENTRY POINTED TO IS REMOVED FROM THE IST AND THE
; TABLE IS COLLAPSED WITH ISTPTR BEING DECREMENTED.
;
PMFIX: TRNE T3,2 ;CONVERT TO HALFWORD RELOCATION
TLO T3,1
TRZ T3,2 ;I.E. 1,,0 ETC INSTED OF 1B34
PUSH P,T3 ;SAVE RELOCATION
MOVE T3,1(T1) ;GET FLAG WORD OF PAIR
TXNN T3,IS.LH ;IS THIS A LEFT HALF FIXUP?
JRST .+3 ;NO,SKIP SWAP
HRLZS T2 ;YES,GET IT INTO POSITION
HRLZS 0(P) ;THE VALUE AND RELOCATION
TXNN T3,IS.NEG ;IS THIS A NEGATIVE REQUEST?
JRST .+3 ;NO,SKIP NEGATION OF VALUE,RELOC
MOVNS T2 ;YES,NEGATE VALUE
MOVNS 0(P) ;AND RELOCATION
HRRZ A,1(T1) ;PICK UP LOCATION TO BE FIXED UP
PUSHJ P,WRDSRC ;MAP IT IN CORE
$STPCD(INTERIM SYMBOL TABLE fouled up)
MOVE T4,0(C) ;PICK UP ORIGINAL
ADDM T2,0(C) ;ADD IN OUR STUFF
TXNN T3,IS.LH!IS.FW ;IF NOT LH OR FULLWORD
HLLM T4,0(C) ;INSURE LH NOT DISTURBED
PUSHJ P,GETREL ;GET RELOCATION FROM (B) &(C)
POP P,T4 ;GET NEW RELOCATION
TRNE D,2 ;CONVERT TO USEABLE FORMAT
TLO D,1 ;FOR ADDITION
TRZ D,2
PUSH P,D ;SAVE IT
ADD D,T4 ;MERGER RELOCATIONS
TXNN T3,IS.LH!IS.FW ;UNLESS LH OR FULL WORD
HLL D,0(P) ;RESTORE LH OF RELOCATION
POP P,0(P) ;
TDNE D,[^-<1,,1>] ;MAKE SURE ITS VALID
JRST FXRERR ;
TLNE D,1 ;RESET TO RELOCATION IN BITS 34-5
TRO D,2 ;
HRRZS D
PUSHJ P,CHGREL ;AND RE-DEPOSIT RELOCATION
PMFIX1: PUSH P,T1 ;SAVE T1 ACROSS CALL
MOVE T2,[POINT 1,ISTMAP] ;POINTER TO MAP
SUBI T1,IST ;GET INDEX INTO IST
LSH T1,-1 ;TWO WORDS PER PAIR
IBP T2 ;INCREMENT BYTE POINTER
SOJGE T1,.-1 ;TO BE IN RIGHT PLACE
SETZM T1
DPB T1,T2 ;DEPOSIT BYTE
PJRST T1POPJ ;RETURN, RESTORING BYTE POINTER
FXRERR: MOVE N,0(T1) ;PICK UP SYMBOL NAME
$KILL(IRF,Illegal relocation in FORWARD reference to,N$SIX,$MORE)
JRST SAYEDT
SUBTTL MACRO STATMENT EVALUATOR
; /EVAL/ - THIS ROUTINE TAKES INPUT FROM THE SOURCE STREAM
; AND RETURNS A FULL WORD THAT IS THE RESULT OF EVALUATING IT
; AS MACRO-10 ASSEMBLY LANGUAGE.
; IT ALSO SETS UP THE IST (INTERIM SYMBOL TABLE) AND THE
; SYMBOL TABLE .
;
EVAL: MOVEM P,EVLPP ;SAVE PDL POINTER ON ENTRY
PUSHJ P,MACLOD ;GET A LINE OF MACRO CODE
EVAL0: PUSHJ P,MACSAV ;SAVE BUFFER POINTER
BYPASS ;GET FIRST NON-BLANK CHARACTER
CAIN CC,";" ;IF INTO COMMENT,
PUSHJ P,FINLIN ;FINISH THE LINE OFF
CAIN CC,$EOL ;END OF LINE?
JRST EVAL ;YES,IGNORE LINE
TXO F,REGET ;REGET CHARACTER
EVAL1: SKPNUM ;IS NEXT CHARACTER A DIGIT?
SKPR50 ;NO, IS IT RADIX50 SYMBOL?
JRST EVAL5 ;NOT LABEL
CAIN CC,"." ;"." FOLLOWED BY 0-9 IS A NUMBER
JRST [PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
CAIL A,"0"
CAILE A,"9" ;BASE 10
JRST .+1 ;NOT NUMERIC
JRST EVAL5] ;WAS NUMERIC
PUSHJ P,SYMIN ;GET A SYMBOL
CAIE CC,":" ;DID IT END WITH COLON?
JRST [ PUSHJ P,MACRST ;RESTORE
JRST EVAL5] ;AND CONTINUE
MOVE R,A ;LOAD R WITH SYMBOL NAME
PUSHJ P,SYMSRC ;AND LOOK IT UP
CAIA ;NOT THERE SO ITS OK
JRST MERROR ;DONT ALLOW REDEF OF EXISTING LABEL
SETZ B, ;START WITH NO SYMBOL FLAGS
PUSHJ P,MACPEK ;LOOK BEHIND THE ":"
CAIE A,":" ;IS IT A COLON TOO?
JRST EVAL2 ;NO
PUSHJ P,MIC ;YES,SWALLOW IT
TXO B,R5.GLB ;FLAG AS GLOBAL DECLARATION
PUSHJ P,MACPEK ;LOOK BEHIND THE SECOND COLON
EVAL2: CAIE A,"!" ;EXCL PT. BEHIND COLON?
JRST EVAL3 ;NO
PUSHJ P,MIC ;YES,SWALLOW IT
TXO B,R5.DDT ;AND FLAG AS SUPRESSED
EVAL3: MOVEM R,LLABEL ;STORE LAST LABEL
SETZM LLOFF ;AND ZERO THE OFFSET
PUSHJ P,RAD50 ;CONVERT TO RADIX50
IOR R,B ;TURN ON ANY FLAGS COLLECTED
MOVE A,CPADDR ;GET VALUE FOR THIS SYMBOL
TXNN F,IAI ;ARE WE IN AN INSERT?
JRST [ MOVE N,LLABEL
$WARN(LII,LABEL outside of .INSERT was ignored:,N$SIX)
JRST EVAL0]
MOVEI B,1 ;RELOCATE THE ADDRESS OF SYMBOL
PUSHJ P,NEWSYM ;REGISTER THE SYMBOL
JRST STOERR ;SYMBOL TABLE OVERFLOW
PUSHJ P,PMLOC ;CLEAR ANY LOCAL FIXUPS ON THIS SYMBOL
JRST EVAL0 ;CHECK FOR MORE LABELS,ETC.
EVAL5: MOVEI A,ETCERR ;GET PDL OVERFLOW TRAP LOCATION
MOVEM A,.JBAPR## ;AND SET FOR APR INTERUPT
MOVX A,AP.POV ;TRAP ONLY PDL OVERFLOW
APRENB A, ;DO IT
SETZM OPRPTR ;CLEAR STACK POINTERS
SETZM OPTPTR ;FOR OPERATORS AND OPERANDS
PUSHJ P,EVALPS ;EVALUATE PRIMARY STATEMENT
CAIE CC,$EOL ;SHOULD ONLY RETURN ON $EOL
JRST QERROR ;ILLEGAL TERMINATOR
SKIPE NULFLG ;IF NULL STATEMENT,GO GET
JRST EVAL ;GET ANOTHER ONE
SETZM .JBAPR## ;UN-DO THE TRAP
SETZ A, ;FOR PDL OVERFLOW
APRENB A, ;SINCE IT COULD BE MISLEADING
MOVE C,CPADDR ;CURRENT ADDRESS
TXO C,IS.GEN ;FLAG THAT WORD HAS BEEN GENERATED
HRRZ B,R%S ;SEE IF IST NEEDS FIXUP
JUMPE B,.+2
IORM C,1(B) ;SET IT UP
HLRZ B,R%S ;
JUMPE B,.+3 ;SAME FOR LEFT HALF
TXO C,IS.LH ;LEFT HALF FIXUP FLAG
IORM C,1(B) ;DONE
MOVE D,R%R ;MAKE CHECK ON RELOCATABILITY
TDNE D,[^-<1,,1>] ;CAN BE 0,,0 1,,1 1,,0 OR 0,,1
JRST RERROR ;BUT IT WASNT, CALL IT ERROR
POPJ P, ;RETURN
COMMENT \
THIS ROUTINE IS A RECURSIVE MACRO STATMENT EVALUATOR
WHICH IS CALLED WHENEVER :
1) THERE IS A PRIMARY STATEMENT (IE JUST LEFT LABEL FIELD)
2) A LEFT BRACKET 74 WAS SEEN
3) A LEFT PARENTHESIS WAS SEEN "("
4) A LEFT BRACKET WAS SEEN "["
THE CURRENT STATE IS SAVED ON ENTRY, AS REFLECTED BY THE
ACS %F,%V,%R,%S. THE RESULT IS RETURNED ON EXIT IN THE MEMORY LOCATIONS
R%F,R%V,R%R,R%S.
USAGE: %V CONTAINS THE VALUE OF THE STATEMENT
%R CONTAINS IN EACH HALF THE MULTIPLIER OF RELOC CONSTANT
WHICH CAN BE EITHER 0 OR 1
%S CONTAINS IN EACH HALF EITHER 0 OR THE ADDRESS OF A
TWO WORD ENTRY IN THE IST FOR FIXING UP FORWARD REFERENCES
%F CONTAINS FLAGS INDICATING OUR POSITION
IN THE MACRO-10 STATEMENT.
EVALUATION OF THE MACRO-10 EXPRESSIONS IS DONE USING A TWO STACK
PRECEDENCE GRAMMAR EVALUATOR. ONE STACK CONTAINS THE OPERANDS
AND THE OTHER CONTAINS THE OPERATORS.
EACH OPERAND ENTRY CONTAINS 4 WORDS,SIMILIAR
IN USE TO THE ACS %F,%V,%R,AND %S. THESE ARE COMBINED
TO FORM LARGER EXPRESSIONS AND FINALLY A FULL MACRO-10 STATEMENT.
\
; LOCAL ACS
%V==T1
%R==T2
%S==T3
%F==T4
; FLAGS IN %F
$1BIT==1
BIT(C.SYM) ;CURRENT CELL IS A SYMBOL
BIT(C.NUM) ;CURRENT CELL IS A NUMBER
BIT(C.AT) ;CURRENT CELL WAS "@"
BIT(C.IDX) ;CURRENT CELL WAS "(...)"
BIT(C.FLT) ;CURRENT CELL IS FLOATING POINT
BIT(C.UDF) ;CURRENT CELL IS AN UNDEFINED SYMBOL
BIT(C.EXT) ;CURRENT CELL IS EXTERNAL SYMBOL
BIT(C.LHNZ) ;CURRENT CELL HAS DATA IN LH
BIT(C.NULL) ;CURRENT CELL IS NOT THERE
BIT(C.OP) ;CURRENT CELL IS AN OP CODE SYMBOL
BIT(C.ASG) ;CURRENT CELL IS SYMBOL TO ASSIGN VALUE TO
BIT(C.POP) ;CURRENT CELL IS A PSEUDO-OP SYMBOL
BIT(C.LIT) ;CURRENT CELL IS A PSEUDO-LITERAL
; BITS USED IN %F REGISTER FOR CURRENT CONTEXT
$1BIT==1
BIT(S.AT) ;SEEN A @
BIT(S.ADR) ;SAW AN ADDRESS
BIT(S.IDX) ;SAW AN INDEX
BIT(S.AC) ;SAW AN AC
BIT(S.OP) ;SEEN AN OPCODE
BIT(S.ASG) ;THIS STATEMENT ASSIGNS VALUE
BIT(S.DC) ;SAW A ,,
BIT(S.DC1) ;TEMP BIT FOR ,, PROCESSING
BIT(S.IOWD) ;SEEN AN IOWD
BIT(S.XWD) ;SEEN AN XWD
BIT(S.EXT) ;SAW "##" AFTER SYMBOL NAME
BIT(S.DEF) ;SAW "#" AFTER SYMBOL NAME
BIT(S.NNUL) ;STATEMENT IS NOT NULL
BIT(S.IOI) ;STATEMENT CONTAINS AN IO TYPE INSTRUCTION
BIT(S.NPS) ;STATEMENT IS NOT PRIMARY,IE. "<>" OR "[]" OR "()"
BIT(I.OP) ;IN OP-CODE FIELD
BIT(S.ASCZ) ;CURRENT ASCII GETS NULL AT END
BIT(P.IOWD) ;IOWD PSEUDO OP PENDING
BIT(P.XWD) ;XWD PENDING
BIT(P.AT) ;@ INDICATOR PENDING
BIT(S.CN1) ;CURRENT NESTING LEVEL
BIT(S.CN2) ;..
BIT(S.CN3) ;..
BIT(S.CN4) ;..
BIT(S.CN5) ;..
BIT(S.CN6) ;..
S.CNL==S.CN1!S.CN2!S.CN3!S.CN4!S.CN5!S.CN6 ; MAKE ACCESS MASK
; EVALUATE A STATEMENT
EVALPS: TDZA D,D ;EVALUATE PRIMARY STATEMENT
EVALS: SETO D, ;EVALUATE NON-PRIMARY STATEMENT
PUSH P,%F ;SAVE CURRENT STATE
PUSH P,%S
PUSH P,%R
PUSH P,%V ;ACS %(F,S,R,V)
SETZB %R,%F ;CLEAR THE ACS
SETZB %V,%S ;FOR CURRENT USE
SKIPE D ;ARE WE JUST AFTER LABEL FIELD?
TXO %F,S.NPS ;NO, SO NOT PRIMARY STATEMENT
MOVE D,NSTLVL ;GET CURRENT NESTING LEVEL OF <>
DPB D,[POINTR(%F,S.CNL)] ;STORE INTO CONTEXT REGISTER
TXO %F,I.OP ;START IN OP CODE FIELD
EVALS1: PUSHJ P,EVALEX ;GET FIRST EXPRESSION
TXNN D,C.ASG ;IS THIS ASSIGNMENT?
JRST EVLS1A ;NO,SO SKIP SETTING UP
TXOE %F,S.ASG ;REMEMBER THIS FOR LATER
JRST QERROR ;ERROR IF WE ALREADY KNOW
PUSH P,ASGSYM ;SAVE OLD SYMBOL TO ASSIGN TO
PUSHJ P,ASGEVL ;GO EVALUATE PLETHORA OF TYPES
JRST EVALS1 ;NOW GO DO THE STATMENT ITSELF
EVLS1A: TXNN D,C.NULL ;IF NOT NULL CELL,
TXO %F,S.NNUL ;TURN ON NOT NULL BIT
TXZN %F,P.AT ;INDIRECT BIT INDICATOR SEEN?
JRST EVALS2 ;NO,SKIP TEST,TURN ON
TXOE %F,S.AT ;ONLY ONE INDIRECT BIT PER STATEMENT
JRST QERROR ;FILTER OUT DUPLICATES
TXO %V,<@> ;TURN IT ON IN THE WORD RETURNED
TXO %F,S.OP ;ILLEGAL TO SEE OPCODE NOW
TXZ %F,I.OP ;AND WE ARE NOT IN THAT FIELD
EVALS2: TXNE %F,I.OP ;IN OPCODE FIELD?
TXNN D,C.OP ;WITH AN OPCODE RETURNED?
CAIA
JRST EVALS4 ;YES,SO ITS NOT AN AC
BYPASS ;GET NEXT CHARACTER
SKPCM ;END WITH COMMA?
JRST [TXO F,REGET ;NO
JRST EVALS4] ;SO ITS NOT AN AC
TXNE %F,P.XWD!P.IOWD ;IF IOWD OR XWD SEEN,
JRST EVLS2B ;PROCESS IT
PUSH P,A ;SAVE AC A
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
CAIN A,"," ;OR IS IT ANOTHER COMMA?
JRST EVLS2A ;YES,HANDLE IT
POP P,A ;NO,RESTORE VALUE
TXNN D,C.IDX+C.AT ;TRY TO CATCH SOME JUNK
TXOE %F,S.AC ;AND CHECK FOR STUFF
JRST QERROR ;ONLY 1 AC FIELD ALLOWED
JUMPN B,RERROR ;MUST BE ABSOLUTE AND DEFINED
JUMPN C,FERROR ;TO BE USED AS AN AC
ANDI A,177 ;MASK TO MAXIMUM
TXNN %F,S.IOI ;IS THIS AN IO INSTRUCTION?
TXZA A,<^-17> ;NO,MASK TO AC WIDTH AND DON'T LSH
LSH A,1 ;1+LATER 23 IS PROPER LSH FOR IO DEVICE
LSH A,^D23 ;GET IT INTO POSITION
ADD %V,A ;AND ADD INTO IT
JRST EVALS7
EVLS2A: POP P,A ;RESTORE VALUE
PUSHJ P,MIC ;EAT THE SECOND COMMA
EVLS2B: TXOE %F,S.DC!S.AC!S.XWD!S.IOWD ;MAKE SYNTAX CHECK
JRST QERROR ;
TXO %F,S.DC1 ;MORE PROCESSING LATER
JRST EVALS5 ;CONTINUE
EVALS4: TXNN D,C.IDX ;INDEX?
JRST EVALS5 ;NO
TXOE %F,S.IDX ;PREVENT DUPLICATES
JRST QERROR
TXO %F,S.OP!S.AC!S.AT!S.ADR ;PREVENT ANY FURTHER STUFF
ADD %V,A ;ADD IN
ADD %R,B ;ALSO THE RELOCATABILITY
JRST EVALS6 ;CHECK IST AND CONTINUE
EVALS5: TXZN %F,I.OP ;STILL IN OPCODE FIELD?
JRST EVLS5A ;NO,MUST BE ADDRESS FIELD
TXOE %F,S.OP ;FLAG OPCODE SEEN AND
JRST QERROR ;KILL ON DUPLICATE
MOVE %V,A ;LOAD VALUE
MOVE %R,B ;RELOCATABILITY
JRST EVALS6 ;CONTINUE AS USUAL
EVLS5A: TXOE %F,S.ADR ;ADDRESS?
JRST QERROR ;BY DEFAULT , I GUESS IT IS
TXO %F,S.OP!S.AC!S.AT ;PREVENT REDUNDANT STUFF
TLNE A,-1 ;IS LEFT HALF ZERO?
TLC A,-1 ;NO,TRY COMPLEMENT
TLNE A,-1 ;AND REPEAT TEST
JRST QERROR ;ERROR IF NOT -1,,VALUE OR 0,,VALUE
TLNE C,-1 ;CANT BE A FIXUP ON LH
JRST QERROR
MOVX T,IS.FW ;SET UP FOR FULL WORD FLAG
SKIPE C ;DOES THIS HALF HAVE FIXUP?
ANDCAM T,1(C) ;YES,CLEAR FULL WORD BIT
MOVE T,%V ;DO HALF WORD ADDITION
ADD T,A ;SO DONT WIPE OUT
HRRM T,%V ;OPCODE ETC.
ADD %R,B ;ADD IN THE RELOCATION TOO
EVALS6: TLNE %S,-1 ;DONT ALLOW 2 RHALVES OR 2 LHALVES ON
TLNN C,-1
CAIA
JRST FERROR
TRNE %S,-1
TRNN C,-1
CAIA
JRST FERROR ;IE LH(%S) + RH(C) IS OK,ETC
IOR %S,C ;MERGE THE TWO
TXZN %F,S.DC1 ;HALFWORD SWAP INDICATED?
JRST EVALS7 ;NO,SO CHECK DELIMITERS
TLNN %R,-1 ;IF FIXED UP OR RELOCATED LH
TLNE %S,-1 ;
JRST QERROR ;THEN CANT DO WITHOUT LOSING DATA
TLNE %V,-1 ;IS VALUE ITSELF 0 IN LH?
TLC %V,-1 ;NO,TRY TO SEE IF ITS -1
TLNE %V,-1 ;AND REPEAT TEST
JRST QERROR ;INDICATE LOST DATA
MOVSS %V ;SWAP VALUE
MOVSS %R ;RELOCATION
MOVSS %S ;AND FIXUP
;FALL INTO EVALS7
EVALS7: TXZ %F,I.OP ;NOT IN OPCODE AFTER FIRST TOKEN
BYPASS ;GET NEXT NON BLANK
CAIN CC,RABRKT ;CHECK FOR R. ANGLE BRACKET
JRST [ LDB T,[POINTR(%F,S.CNL)] ; GET ENTRY NESTING LEVEL
CAMN T,NSTLVL ;ARE WE AT THAT LEVEL NOW?
JRST EVALS9 ;YES, SO THIS BRACKET ENDS STATEMENT
SOS NSTLVL ; ELSE DECREMENT NST LEVEL
JRST EVALS7 ] ; AND TRY AGAIN
CAIN CC,";" ;IS THIS COMMENT START?
PUSHJ P,FINLIN ;YES,FINISH LINE OFF
CAIE CC,")" ;RIGHT PARENTHESIS OR
CAIN CC,$EOL ; END OF LINE FINISHES STATEMENT
JRST EVALS9 ;
CAIN CC,"]" ;ALSO , END OF LITERAL DOES TOO
JRST EVALS9
TXO F,REGET ;NOT A TERMINATOR, REGET IT
JRST EVALS1 ;AND RE-ITERATE
EVALS9: TXNN %F,P.IOWD ;IOWD SEEN?
JRST EVLS9A ;NO,SO SKIP THE FIX UP
TLNE %R,-1 ;ABSOLUTE REQUIRED
JRST RERROR
TLNE %S,-1 ;MUST BE KNOWN TOO
JRST FERROR
HLRZ T,%V ;GET VALUE TO NEGATE
MOVNS T ;NEGATE IT
SOS %V ;BACK ADDRESS BACK ONE
HRLM T,%V ;RESTORE VALUE (LH)
EVLS9A: MOVEM %V,R%V ;RETURN ACS INTO R%<AC>
MOVEM %R,R%R ;
MOVEM %S,R%S
MOVEM %F,R%F ;FOR LATER EXAMINATION
SETZM NULFLG ;CLEAR "THIS IS NULL STATEMENT" FLAG
TXNN %F,S.NNUL ;IS NOT NULL FLAG ON?
SETOM NULFLG ;NO,SO IT IS NULL
TXNN %F,S.ASG ;WAS THIS BEING ASSIGNED TO SYMBOL?
JRST EVLS9B ;NO,SO DONT CALL ASGMAK
PUSHJ P,ASGMAK ;MAKE THE ASSIGNMENT
POP P,ASGSYM ;RESTORE PREVIOUS VALUE
EVLS9B: POP P,%V ;RESTORE PREVIOUS VALUES
POP P,%R
POP P,%S
POP P,%F ;
POPJ P, ;AND THEN RETURN
; /EVADR/ - ROUTINE TO EVALUATE STANDARD ADDRESS FORMAT
;
; THIS ROUTINE RETURNS IN THE AC BLOCK A-D AN EXPRESSION
; CREATED BY EVALUATING A STRING OF THE FORM:
; (WITH ALL PARTS OPTIONAL)
; <@> <EXPRESSION> <(EXPRESSION)>
EVADR: SETZ A, ;START WITH 0
BYPASS
CAIN CC,"@" ;INDIRECT BIT WOULD COME FIRST
SKIPA A,[<@>] ;MARK PROPER BIT ON
TXO F,REGET ;OTHERWISE,REGET CHARACTER
PUSH P,A ;SAVE PARTIAL RESULT
PUSHJ P,EVALEX ;EVALUATE ADDRESS PART
TLNE A,-1 ;INSURE LH=0
TLC A,-1
TLNE A,-1
JRST QERROR ;
IORM A,0(P) ;UPDATE PARTIAL RESULT
PUSH P,B ;SAVE RELOC
PUSH P,C ;SAVE FIXUP
CAIE CC,"(" ;DO WE HAVE INDEX NEXT?
JRST EVADR2 ;NO,SO SKIP IT
PUSHJ P,EVALEX ;EVALUATE IT
CAIN CC,")" ;MAKE SURE OF MATCHING PARENS
JRST QERROR ;ELSE BOMB OUT
BYPASS ;LOAD NEXT CHARACTER
TXO F,REGET ;FOR CHECKS LATER
MOVE T,0(P) ;GET FIXUP WORD
TLNE T,-1 ;PREVENT FOULUPS
JRST [TLNE C,-1
JRST FERROR
JRST .+1]
TRNE T,-1
JRST [TRNE C,-1
JRST FERROR
JRST .+1]
ADDM A,-2(P) ;UPDATE VALUE
ADDM B,-1(P) ;UPDATE RELOCATION
ADDM C,0(P) ;UPDATE FIXUP
EVADR2: POP P,C ;RETURN WITH FIXUPS HERE
POP P,B ;RELOC HERE
POP P,A ;VALUE HERE
TLNE C,-1 ;DONT ALLOW LH FIXUPS
JRST QERROR
MOVX T,IS.FW ;GET FULLWORD FIXUP FLAG
SKIPE C ;IS THERE A FIXUP HERE?
ANDCAM T,1(C) ;YES,SHUT OFF FULLWORD OK FLAG
TDNE A,[<^-<Z @ -1(17)>>] ;GENERATE Q ERROR IF NON-ADDR
JRST QERROR ;AREN'T 0
MOVX D,C.NUM ;CALL IT A NUMBER
POPJ P, ;AND RETURN
; /EVALEX/ - THIS ROUTINE COMBINES CELLS SEPARATED BY BINARY OPERATORS
; INTO EXPRESSIONS. THE ROUTINE USES A TABLE OF OPERATORS AND
; THEIR RELATIVE PRECEDENCE TO KNOW WHEN TO STACK AND WHEN TO EXECUTE
; AND COLLAPSE. THE ROUTINE EXITS WHEN THE SYMBOL AFTER
; A READ IN CELL IS NOT RECOGNIZED AS A VALID BINARY OPERATOR.
; TWO STACKS ARE USED: OPRSTK FOR OPERANDS AND OPTSTK FOR
; OPERATORS. SPECIAL SAFETY CHECKS ARE MAINTAINED TO INSURE PHASE OF THESE STACKS
; ROUTINE CELL RETURNS THE 4 REGISTER BLOCK OF
; VALUE,RELOCATION,FIXUP , FLAGS IN ACS A-D AND EVALEX IN TURN RETURNS ONE
; VALUE FOR THE WHOLE EXPRESSION, IN THESE ACS.
;
IMPCHR==200 ;IMPOSSIBLE ASCII CHARACTER
;USED TO MAKE CHARACTER ENTRY IN TABLES
;FOR TWO CHARACTER OPS (IE ^!)
EVALEX: PUSH P,OPRTOP ;SAVE LAST TOP OF STACK
PUSH P,OPTTOP ;FOR OPERANDS AND OPERATORS
MOVE T,OPTPTR ;SET OUR CURRENT STACK FRAME START
MOVEM T,OPTTOP
MOVE T,OPRPTR ;SO WE KNOW OUR LIMITS
MOVEM T,OPRTOP
PUSHJ P,CELL ;GET FIRST CELL
TXNE D,C.NULL ;IS IT THE NULL CELL?
JRST EVLXX1 ;YES,RETURN 0
SKIPA ;PROCESS EXPRESSION
EVALXB: PUSHJ P,CELL ;GET A CELL
EVLXB1: TXNE D,C.NULL ;DONT ALLOW NULL CELLS HERE
JRST QERROR
PUSHJ P,PSHOPR ;PUSH OPERAND QUARTET ONTO STACK
TXNN %F,I.OP ;SPECIAL CHECK FOR OPCODE FIELD
JRST EVLXB2 ; NOT IN THAT FIELD
TXNE D,C.OP!C.ASG ;IS THIS OPCODE OR ASSIGNMENT SYMBOL?
JRST [SETZ A, ;YES,SO FORCE END OF EXPRESSION
JRST EVALX2] ;
EVLXB2: BYPASS ;GET FIRST NON-BLANK CHAR
TXNE D,C.NUM ;SKIP THIS IF CELL NON-NUMERIC
CAIE CC,"B" ;DID CELL TERMINATE ON "B"?
JRST EVLXB3 ;NO,SO SKIP THIS
PUSH P,A ;SAVE A
PUSH P,CC ;SAVE CC
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
SETZ T, ;ZERO FLAG
MOVE CC,A ;GET INTO POSITION
SKPNUM ;SEE IF NEXT CHARACTER IS DIGIT
SKPR50 ;SEE IF NEXT CHARACTER IS RADIX50
SETO T, ;TURN FLAG ON IF NUMERIC OR NOT RADIX50
POP P,CC ;RESTORE CC
POP P,A ;RESTORE A
JUMPL T,EVALXN ;PROCESS BIT POSITIONER
EVLXB3: CAIN CC,"^" ;IF CHARACTER IS UPARROW
JRST [ PUSHJ P,MACPEK ;LOOK AHEAD
CAIE A,"!" ;CURRENT BOP FOLLOWING ^ IS !
JRST .+1
PUSHJ P,MIC
MOVEI CC,IMPCHR+"!"
JRST .+1]
MOVSI A,-BOPLEN ;LENGTH OF TABLE
EVALX1: LDB B,[POINT 8,BOPTAB(A),7] ;GET A CHARACTER FROM TABLE
CAMN B,CC ;IS IT A MATCH?
JRST EVALX2 ;YES,WE HAVE A BOP
AOBJN A,EVALX1 ;NO. ANY MORE LEFT?
TXO F,REGET ;RE-EAT THE CHARACTER
SKIPA A,[0] ;USE FAKE INDEX OF 0
EVALX2: HRRZS A ;A IS NOW INDEX TO TABLE
MOVE T,OPTPTR ;GET POINTER TO OPTSTAK
CAMN T,OPTTOP ;IS IT THE EMPTY STACK?
JRST [JUMPLE A,EVALXX ;YES,IF A.LE.0,SIMPLE CELL
MOVE T,A ;SO SAVE OPERAND,OPERATOR ON STACK
PUSHJ P,PSHOPT ;FOR LATER EVALUATION
JRST EVALXB] ;AND GET RH OF EXPRESSION
LDB B,[POINT 5,BOPTAB(A),12] ;GET PRECEDENCE OF WINDOW OP
PUSHJ P,POPOPT ;POP OP ON TOP OF STACK
LDB C,[POINT 5,BOPTAB(T),12];GET ITS PRECEDENCE
CAML C,B ;EXECUTE TIME?
JRST EVALX4 ;YES,GO DOIT
PUSHJ P,PSHOPT ;NO,RESTORE OLD OP TO TOP OF STACK
MOVE T,A ;GET INDEX OF CURRENT OP
PUSHJ P,PSHOPT ;STACK IT TOO
JRST EVALXB ;GET NEXT CELL
EVALX4: PUSH P,A ;SAVE WINDOW OP'S INDEX
PUSHJ P,$XCT ;EXECUTE THE OPERATOR
POP P,A ;RESTORE INDEX
JRST EVALX2 ;AND RE-ITERATE
EVALXX:PUSHJ P,POPOPR ;LOAD A-D WITH FINAL OPERAND QUARTET
MOVE T,OPRPTR ;FINAL CONSISTENCY CHECK
CAME T,OPRTOP ;STACK SHOULD BOTH BE EMPTY
JRST QERROR
EVLXX1: POP P,OPTTOP ;RESTORE TOP OF STACKS
POP P,OPRTOP ;FOR LAST CALLER
TLNN A,-1 ;SEE IF ANY DATA IN LEFT HALF OF
TLNE B,-1 ;RETURNED EXPRESSION
TXO D,C.LHNZ ;FOR EASE OF CHECK VALIDITY
TLNE C,-1 ;LATER
TXO D,C.LHNZ ;
POPJ P, ;AND RETURN
EVALXN: ;HERE FOR <NUMBER>B<CELL>
PUSHJ P,CELL10 ;EVALUATE NEXT CELL,RADIX10.
TXNE D,C.NULL ;IF NULL CELL
JRST NERROR ;ITS AN ERROR
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;IN CASE WE DONT KNOW IT
MOVEI T,^D35 ;SET UP FOR SHIFT
SUB T,A ;SHIFT 36-<CELL>
PUSHJ P,POPOPR ;GET THE OPERAND
LSH A,(T) ;SHIFT INTO PLACE
LSH B,(T) ;ALSO SHIFT RELOCATABLE BITS
JRST EVLXB1 ;AND CONTINUE
EVLX10: ;HERE TO CALL EVALEX WITH RADIX=^D10
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEI T,^D10 ;USE BASE 10.
MOVEM T,CRADIX ;FOR RADIX IN THIS EXPRESSION
PUSHJ P,EVALEX ;NOW EVALUATE EXPRESSION
POP P,CRADIX ;RESTORE RADIX
POPJ P, ;AND RETURN
; SUBROUTINE TO EXECUTE BINARY OPERATORS IN MACRO STATEMENTS
;
; ENTER WITH AC T BEING THE INDEX INTO BOPTAB
; TOP TWO OPERAND QUARTETS ON OPRSTK ARE EVALUTED AND THE RESULT
; PUSHED BACK ONTO OPRSTK
;
; LOCAL REGISTER ASSIGNMENTS
%LV==A ;LEFT HAND VALUE
%LR==B ;LEFT HAND RELOC
%LS==C ;LEFT HAND SYMBOL FIXUP
%LF==D ;LEFT HAND FLAGS
%RV==T1 ;RIGHT HAND VALUE
%RR==T2 ;RIGHT HAND RELOC
%RS==T3 ;RIGHT HAND SYMBOL FIXUP
%RF==T4 ;RIGHT HAND FLAGS
$XCT: PUSHJ P,.PSH4T## ;SAVE ACS,WE NEED THEM
PUSHJ P,POPOPR ;GET OPERAND (LH)
MOVE %RV,A ;STORE RIGHT HAND SIDE AWAY
MOVE %RR,B
MOVE %RS,C
MOVE %RF,D
PUSHJ P,POPOPR ;POP LEFT HAND OPERAND
JRST @BOPTAB(T) ;DISPATCH ON TABLE
$ADD: ADD %LV,%RV ;ADD IS LV+RV
ADD %LR,%RR ;ADD IS RELOC+RELOC
TLNE %LS,-1 ;ALLOW EITHER HALF TO BE FIXED UP
JRST [ TLNE %RS,-1
JRST FERROR
JRST .+1]
TRNE %LS,-1
JRST [ TRNE %RS,-1
JRST FERROR
JRST .+1]
IOR %LS,%RS ;INCLUSIVE OR THE SYMBOL FIXUPS
JRST $XCT2 ;DONE
$SUB: MOVE T,%RS ;GET RH SYMBOL FIXUP
JUMPN T,[JUMPN %LS,FERROR ;CHECK FORWARD REFERENCE
PUSH P,A
MOVX A,IS.DER ;DONT ALLOW SUBTRACTION OF EXTERNAL
TDNE A,1(T)
JRST FERROR
MOVX A,IS.NEG ;NEGATE FIXUP
IORM A,1(T) ;SET FLAG TO INDICATE IT
HLRZS T
POP P,A
JRST .] ;TRY OTHER HALF
IOR %LS,%RS
SUB %LV,%RV ;DO THE SUBTRACTION
SUB %LR,%RR ;ALSO THE RELOCATION
JRST $XCT2 ;AND CONTINUE
$MUL: JUMPE %LR,.+3 ;MUST HAVE ONE SIDE FIXED
JUMPE %RR,.+2 ;
JRST RERROR ;BUT WE DONT
JUMPN %LS,FERROR ;CANT LET
JUMPN %RS,FERROR ;EITHER SIDE BE DEFERRED
TXNN %LF,C.FLT ;CANT MULTIPLY FLOATING POINT
TXNE %RF,C.FLT ;
JRST NERROR ;
IOR %LR,%RR ;
JUMPE %RR,.+2 ;MAKE RIGHT SIDE BE FIXED VALUE
EXCH %RV,%LV ;SO RELOC COMES OUT RIGHT
IMUL %LV,%RV ;DO THE MULTIPLICATION
IMUL %LR,%RV ;ALSO ON THE RELOC BITS
JRST $XCT2 ;DONE
$DIV: JUMPN %LS,FERROR ;BOTH SIDES MUST BE KNOWN
JUMPN %RS,FERROR
JUMPN %RR,RERROR ;DENOMINATOR MUST BE FIXED
TXNN %LF,C.FLT ;CANT DIVIDE FLOATING POINT
TXNE %RF,C.FLT ;
JRST NERROR ;
PUSH P,%LV+1 ;COVER UP
IDIV %LV,%RV ;DIVIDE
POP P,%LV+1
IDIV %LR,%RV ;
SETZM %LS ;INCASE DIVIDE OF %LR PUTS ANYTHING HERE
JRST $XCT2 ;DONE
$AND: JUMPN %LS,FERROR ;FOR AND MUST HAVE BOTH SIDES
JUMPN %RS,FERROR
IOR %LR,%RR ;FOR LATER CHECK
AND %LV,%RV ;AND THE VALUES
JRST $XCT1 ;THATS ALL
$OR: JUMPN %LS,FERROR ;MUST KNOW BOTH
JUMPN %RS,FERROR
IOR %LV,%RV ;OR THE VALUES
IOR %LR,%RR ;AND RELOC
JRST $XCT1 ;DONE
$XOR: JUMPN %LS,FERROR ;CANT USE DEFERRED VALUES
JUMPN %RS,FERROR
XOR %LV,%RV ;XOR
IOR %LR,%RR ;FOR LATER CHECK
JRST $XCT1
$LSH: JUMPN %LS,FERROR ;
JUMPN %RS,FERROR ;BOTH MUST BE KNOWN
JUMPN %RR,RERROR ;SHIFT VALUE MUST BE FIXED
LSH %LV,(%RV) ;DO THE SHIFT
LSH %LR,(%RV) ;ALSO ON THE RELOC
JRST $XCT2
$XCT1: JUMPN %LR,RERROR ;CHECK FOR FIXED RESULT
$XCT2: IOR %LF,%RF ;COMBINE FLAGS
PUSHJ P,PSHOPR ;
PUSHJ P,.POP4T## ;RESTORE THE ACS
POPJ P, ;RETURN
; TABLE OF BINARY OPERATORS AND THEIR PRECEDENCES
;
; FORMAT OF EACH ENTRY IS AS FOLLOWS:
;
; BITS:
; 0-7 ASCII CHARACTER OF OPERATOR,NOTE THAT ITS 8 BITS TO ALLOW
; FOR FAKE CHARACTERS.
; 8-12 THE RELATIVE PRECEDENCE FOR THIS OPERATOR, IN RANGE 0-32
; 13 LEAVE IT OFF, SO CAN USE INDIRECT SAFELY
; 18-35 ADDRESS OF ROUTINE TO EXECUTE THIS OPERATOR
;
DEFINE DBOP<
X 0,0,0 ;FAKE ENTRY TO FORCE REDUCTION
X "+",2,$ADD
X "-",2,$SUB
X "*",4,$MUL
X "/",4,$DIV
X "&",6,$AND
X "!",6,$OR
X "!"+IMPCHR,6,$XOR
X "_",8,$LSH
> ; END OF DBOP DEFINITION
DEFINE X($A,$B,$C)<
IFG <$B>-^D32, <PRINTX PRECEDENCE TOO GREAT IN BOPTAB>
<$A>B7+<$B>B12+<$C>
>
BOPTAB: DBOP
BOPLEN==.-BOPTAB
; /CELL/- THIS ROUTINE EVALUATES THE LOWEST LEVEL OF MACRO TOKEN.
; SUCH AS SYMBOL,NUMBER, CONSTANT ETC. THESE ARE COMBINED BY
; EVALEX WITH EVALS DOING THE CONTEXT SENSITIVE INTERPRETATION.
; CELL INTERPRETS THE LOW LEVEL TOKENS BY LOOKING AT THE
; FIRST CHARACTER OF THE CELL AND THEN DISPATCHING TO THE APPROPRIATE
; PROCESSOR FOR THAT CELL. THE VALUE ETC OF THE CELL IS RETURNED
; IN A FOUR WORD AC BLOCK.
;
; OUTPUTS:
; AC A CONTAINS THE VALUE OF THE READ IN CELL
; AC B CONTAINS THE RELOCATION MULTIPLIER IN EACH HALF WORD
; AC C CONTAINS , IN EACH HALFWORD POSSIBLE POINTERS TO THE
; IST FOR FIXUPS ON LITERALS,EXTERNALS AND FORWARD REFERENCES
; AC D CONTAINS FLAG(S) WHICH TELL HIGHER ROUTINES WHAT KIND
; OF CELL WAS JUST READ IN.
;
; IF THE FIRST CHARACTER IS NOT RECOGNIZED, A Q ERROR IS GENERATED.
CELL: PUSHJ P,MIC ;GET A CHARACTER
SKPNUM ;TEST FOR NUMERIC
CAIA ;SKIP IF NOT
JRST EVLP1 ;PROCESSOR 1 (NUMBER)
CAIN CC,"." ;PERIOD?
JRST CELL1C ;YES,SHORT CIRCUIT THE SYMBOL CUTOUT
SKPR50 ;RADIX50 SYMBOL?
SKIPA ;NO
JRST EVLP2 ;PROCESSOR 2 (SYMBOL)
CELL1C: MOVSI A,-FCDSPL ;LENGTH OF FIRST CHARACTER TABLE
CELL1D: LDB B,[POINT 7,FCDSP(A),6] ;GET CHARACTER
CAMN CC,B ;A MATCH?
JRST @FCDSP(A) ;YES,GO TO IT
AOBJN A,CELL1D ;MORE LEFT?
JRST QERROR ;NO,SO GIVE ERROR MESSAGE
ECELL: POPJ P, ;RETURN (COMMON CELL EXIT POINT)
NCELL: TXO F,REGET ;REGET THE DELIMITER
SETZB A,B ;CLEAR RESULT
SETZ C,
MOVX D,C.NULL ;FLAG IT AS NULL
JRST ECELL ;AND RETURN
CELL10: MOVEI A,^D10 ;USE RADIX 10.
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEM A,CRADIX ;
PUSHJ P,CELL ;EVALUATE CELL
POP P,CRADIX ;RESTORE RADIX
POPJ P, ;AND RETURN
MECELL: TXO F,REGET ;THIS CELL MUST END LINE,THIS CHARACTER
MCELL1: BYPASS ;START W/NEXT CHARACTER
CAIN CC,";" ;INTO COMMENT?
PUSHJ P,FINLIN ;YES,FINISH OFF THE LINE
CAIN CC,$EOL ;AT END OF LINE?
JRST NCELL ;ITS A NULL CELL
JRST QERROR ;ITS A QERROR
DEFINE FC < ;DEFINE FIRST CHARACTER DISPATCH
;TABLE FOR EVALUATOR
IFE BIGLST,<XLIST>
X " ",CELL ;SKIP BLANKS
X "+",CELL ;AND UNARY "+"
X "@",EVLP3 ;AT SIGN (INDIRECT BIT)
X "-",EVLP4 ;UNARY MINUS "-"
X SQUOTE,EVLP5 ;SINGLE QUOTE,SIXBIT RIGHT JUSTIFIED
X DQUOTE,EVLP5A ;DOUBLE QUOTE ASCII RIGHT JUSTIFIED
X LPAREN,EVLP6 ;( MEANS INDEXING
X LSBRKT,EVLP7 ;[ MEANS START PSEUDO-LITERAL
X LABRKT,EVLP8 ;L. BRACKET,START EXPRESSION
X ".",EVLP9 ;PERIOD. NUMBER,CURRENT LOC, OR SYMBOL
X "^",EVLP12 ;UP-ARROW QUALIFIER
X RABRKT, EVLP13 ;CLOSE ANGLE BRACKET
X SCOLON,NCELL ;IF INTO COMMENT,NULL CELL
X $EOL,NCELL ;SAME FOR END OF LINE
X RSBRKT , NCELL ;AND LITERAL
X RPAREN , NCELL ;AND INDEX
X 54,NCELL ;ALLOWS THINGS LIKE SETZM,FOO
LIST
> ; END OF FC DEFINITION
; NOW LETS CREATE THE TABLE
DEFINE X($A,$B)<
<$A>B6+$B>
FCDSP: FC
FCDSPL==.-FCDSP
; PROCESSOR 1 - PROCESS NUMBER
EVLP1: PUSH P,CC ;SAVE FIRST CHARACTER
TXO F,REGET ;REGET FIRST DIGIT
PUSHJ P,MACSAV ;SAVE POSITION
PUSHJ P,CRADIN ;GET NUMBER
CAIN CC,"." ;IS TERMINATOR A PERIOD?
JRST EVLP1A ;YES,GO HANDLE IT
POP P,0(P) ;CLEAN STACK
SETZB B,C ;NOT RELOCATABLE OR A SYMBOL
MOVX D,C.NUM ;FLAG CELL AS NUMERIC
TXO F,REGET ;REGET OUR DELIMITER
JRST ECELL ;END OF CELL
EVLP1A: PUSHJ P,MACRST ;START NUMBER OVER AGAIN
POP P,CC ;RESTORE CHARACTER
TXO F,REGET ;AND REGET IT
SETZ A, ;CLEAR RESULT
EVLN1A: PUSHJ P,MIC ;GET CHARACTER
CAIN CC,"." ;PERIOD?
JRST EVLN2 ;YES,HANDLE FRACTION
SKPNUM ;IS IT A DIGIT?
JRST NERROR ;NO,BADLY FORMED DIGIT
SUBI CC,"0" ;MAKE NUMBER
TLO CC,233000 ;FLOAT IT
FMPR A,[10.0] ;SHIFT OVER
FADR A,CC ;ADD IN OUR PART
JRST EVLN1A ;GO BACK FOR MORE
EVLN1B: SETZ A, ;NUMBER FRACTION ONLY
EVLN2: MOVE D,[0.1] ;FIRST FRACTION DIGIT
EVLN2A: PUSHJ P,MIC ;GET CHARACTER
SKPNUM ;IS IT NUMERIC?
JRST EVLNF ;NO,FINISH UP
SUBI CC,"0" ;NUMBER IT
TLO CC,233000 ;FLOAT IT
FMPR CC,D ;MULTIPLY TO GET IT FRACTIONAL
FADR A,CC ;ADD IN THIS PART
FDVR D,[10.] ;MAKE OUR FRACTION SMALLER
JRST EVLN2A ;BACK FOR MORE
EVLNF: CAIN CC,"E" ;END IN EXPONENT?
PUSHJ P,NUMEXP ;YES,GO PROCESS
SETZB B,C ;NO FIXUP OR RELOC
TXO F,REGET ;REGET DELIMITER
MOVX D,C.NUM+C.FLT ;
JRST ECELL ;END IT
NUMEXP: PUSH P,A ;SAVE VALUE OF NUMBER
PUSHJ P,CELL10 ;GET EXPONENT IN RADIX10
JUMPE A,QERROR ;E0 IS ILLEGAL
TXNN D,C.FLT+C.IDX+C.LIT+C.SYM+C.NULL ;FILTER OUT SOME JUNK
TXNN D,C.NUM ;BUT MUST BE NUMERIC
JRST NERROR
CAIG A,^D38 ;DONT LET IT BE TOO BIG
CAMGE A,[-^D38] ;OR TOO SMALL
JRST NERROR ;
JUMPN C,FERROR ;MUST BE COMPLETELY KNOWN
JUMPN B,NERROR ;AND NON-RELOCATABLE
MOVE C,[1.0] ;START C WITH EXP MULTIPLIER
MOVE B,[10.0] ;FOR POSITIVE EXPONENT
JUMPG A,NUMEX1 ;WAS IT POSITIVE?
MOVMS A ;NO,MAKE IT SO
MOVE B,[0.1] ;AND MAKE IT FRACTIONAL
NUMEX1: FMPR C,B ;MULTIPLY BY EXPONENT (10. OR 0.1)
SOJG A,.-1 ;GO BACK <EXP> TIMES
FMPRM C,0(P) ;EXPONENTIATE PREVIOUS VALUE
POP P,A ;AND RESTORE IT
CAIN CC,76 ;IF EXPRESSION WAS EXPONENT
PUSHJ P,MIC ;EAT IT
POPJ P, ;THEN RETURN
; PROCESSOR 2 -PROCESS A SYMBOL
EVLP2: TXZ %F,S.EXT!S.DEF ;CLEAR FLAGS
TXO F,REGET ;REGET THE CHARACTER
PUSHJ P,SYMIN ;GET THE SYMBOL
CAIN CC,"=" ;IS THIS "SYMBOL="?
JRST EVLP2D ;YES,GO HANDLE IT
CAIN CC,"#" ;DOES SYMBOL END WITH #?
JRST [PUSHJ P,MIC ;YES,GET NEXT CHARACTER
TXO %F,S.DEF ;CALL IT DEFINING REFERENCE
CAIE CC,"#" ;NEXT CHAR. ALSO A POUND SIGN?
JRST .+1 ;NO,RETURN HAVING EATEN SINGLE #
TXZ %F,S.DEF ;CLEAR FIRST FLAG
TXO %F,S.EXT ;AND,FLAG AS EXTERNAL
PUSHJ P,MIC ;GET NEXT CHARACTER
JRST .+1 ] ;AND RETURN
TXO F,REGET ;REGET DELIMITER OF SYMBOL
MOVE R,A ;PREPARE TO LOOK UP SYMBOL
TXNE %F,I.OP ;IN OPCODE FIELD?
JRST [PUSHJ P,MACSRC ;YES,SEARCH THAT FIRST
JRST .+1 ;SEARC FAILED
JRST EVLP20 ] ;SEARCH WAS SUCCESSFUL
PUSHJ P,SYMSRC ;
JRST [ TXNN %F,I.OP ;IN OPCODE FIELD?
PUSHJ P,MACSRC ;NO,HAVENT TRIED BUILT IN STUFF YET
JRST EVLP2A ;SEARCH EXHAUSTED
JRST EVLP20 ] ;FOUND IN BUILT IN TABLES
CAIN B,60 ;GLOBAL REQUEST TYPE SYMBOL?
JRST EVLP2C ;YES,PROCESS AS SUCH
MOVE B,D ;RELOCATION OF THE SYMBOL
TRNE D,2 ;CONVERT LH RELOCATION TO THIS FORMAT
TLO B,1 ;OF 1,,1 ETC
TRZ B,^-<1> ;DONT ALLOW ANYMORE IN RH
SETZ C, ;NO SYMBOL FIXUP NEEDED
MOVX D,C.SYM ;PUSH THE OPERAND
EVLP20: TXNE %F,S.EXT!S.DEF ;WAS USER SAYING ITS EXTERNAL OR NEW?
JRST MERROR ;BUT ITS LOCAL AND EXISTING,SO COMPLAIN
TXNN D,C.POP ;IS THIS A PSEUDO-OP?
JRST ECELL ;NO, EXIT THE CELL
JRST 0(A) ;RETURNED VALUE IS NAME (IE ADDRESS)
;OF PROCESSOR FOR THIS PSEUDO-OP
JRST ECELL
EVLP2A: PUSHJ P,ISTGET ;GET SLOT IN INTERIM SYMBOL TABLE
MOVEM R,0(C) ;STORE SYMBOL NAME
SETZM 1(C) ;CLEAR SECOND WORD
MOVX D,C.UDF+C.SYM ;FLAG AS UNDEFINED
MOVX A,IS.UDF+IS.FW ;FLAG AS FULLWORD, UNDEFINED
TXNE %F,S.EXT ;WAS IT UNDEFINED EXTERNAL?
TXO A,IS.DER ;YES,DEFERRED EXTERNAL REQUEST
TXNE %F,S.DEF ;WAS THIS DEFINING OCCURENCE?
TXO A,IS.DEF ;YES,REMEMBER FOR LATER
MOVEM A,1(C) ;STORE AWAY THE FLAGS
SETZB A,B ;CLEAR RESULT AND RELOC
JRST ECELL ;END OF CELL
EVLP2C: TXNE %F,S.DEF ;WASNT FOLLOWED BY "#"?
JRST MERROR ;ELSE ITS ERROR
PUSHJ P,ISTGET ;GET SLOT ON IST
MOVEM R,0(C) ;STORE SYMBOL NAME
MOVX A,IS.DER ;DEFFERED EXTERNAL REFERENCE
MOVEM A,1(C) ;STORE IT
SETZB A,B ;CLEAR VALUE,RELOCATION
MOVX D,C.EXT+C.SYM ;EXTERNAL SYMBOL
JRST ECELL ;END OF CELL
;HERE FOR "SYMBOL="
EVLP2D: TXNN %F,I.OP ;ONLY ALLOW IT IN OPCODE FIELD
JRST QERROR ;ELSE ITS ERROR
MOVX D,C.SYM+C.ASG ;FLAG IT THE RIGHT WAY
SETZB B,C ;CLEAR RELOC AND SYMFIX
JRST ECELL ;AND RETURN
; PROCESSOR 3 -PROCESS AN AT-SIGN ( @ )
EVLP3: TXOE %F,P.AT ;INDIRECT BIT PENDING ALREADY?
JRST QERROR ;YES,SO THIS IS AN ERROR
JRST CELL ;AND CONTINUE TO PROCESS THE CELL
; PROCESSOR 4 -PROCESS UNARY MINUS
EVLP4: PUSHJ P,CELL ;GET CELL
TXNE D,C.OP!C.POP!C.AT!C.IDX!C.NULL ;FILTER OUT SOME STUFF
JRST QERROR ;ELSE ITS AN ERROR
JUMPN B,RERROR ;CANT NEGATE ADDRESS
JUMPN C,RERROR ;OR FORWARD REFERENCE
TXO D,C.NUM ;ITS A NUMBER
MOVNS A ;NEGATE CELL VALUE
JRST ECELL ;AND RETURN
; PROCESSOR 5 -PROCESS SIXBIT COMPRESSED ASCII
EVLP5: SETZ A, ;CLEAR RESULT
MOVEI B,6 ;SET MAXIMUM
EVLP56: PUSHJ P,MIC ;LOAD A CHARACTER
CAIN CC,"'" ;IS IT THE END?
JSP C,EVLP5C ;YES,DO END WORK
CAIN CC,$EOL ;DONT ALLOW END OF LINE
JRST QERROR ;INSIDE QUOTE
SOJL B,QERROR ;IF MAXIMUM EXCEEDED
SUBI CC," "-' ' ;CONVERT TO SIXBIT
ANDI CC,77 ;MAKE SURE IT COMES OUT RIGHT
LSH A,6 ;MAKE ROOM
IORI A,(CC) ;OR IN THE NEW CHARACTER
JRST EVLP56 ;GO AGAIN
; PROCESSOR 5A -PROCESS ASCII SEVEN BIT CHARACTERS
EVLP5A: SETZ A, ;CLEAR RESULT
MOVEI B,5 ;5 CHARACTERS
TXO F,QUOTE ;DONT CONVERT CHARACTERS
EVLP57: PUSHJ P,MIC ;GET A CHARACTER
CAIN CC,"""" ;IS THIS THE END?
JSP C,EVLP5C ;YES,DO FINISH UP WORK
SOJL B,QERROR ;IF MORE THAN 5 CHARACTERS
CAIN CC,$EOL ;END OF LINE?
JRST QERROR
LSH A,7 ;MAKE ROOM
IORI A,(CC) ;OR IN THE NEW CHARACTER
JRST EVLP57 ;NEXT CHARACTER
EVLP5C: MOVEM A,T ;SAVE RESULT AWAY
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
EXCH A,T ;RESTORE RESULT, CHAR TO SAFE PLACE
CAME CC,T ;IS THIS CASE OF DOUBLE DELIMITER?
JRST EVLP5D ;NO,SO CONTINUE WITH END
PUSHJ P,MIC ;EAT THE SECOND OCCURENCE
JRST 0(C) ;AND CONTINUE PROCESSING
EVLP5D: SETZB B,C ;CLEAR RELOC,SYMFIXUP
MOVX D,C.NUM ;CALL IT A NUMBER
TXZ F,QUOTE ;RESTORE NORMAL MODE
JRST ECELL ;END OF CELL
; PROCESSOR 6 -PROCESS AN INDEX EXPRESSION "(...)"
EVLP6: PUSHJ P,EVALS ;CALL EVALUATE AGAIN
CAIE CC,")" ;SHOULDNT BE HERE TILL )
JRST QERROR ;IF NOT,ERROR
MOVS A,R%V ;SWAP HALVES OF RETURNED VALUE
MOVS B,R%R ;AND RELOCATION
MOVS C,R%S ;ALSO FORWARD REFERENCES
MOVX D,C.NUM+C.IDX ;NUMERIC,INDEX
JRST ECELL ;END OF CELL
; PROCESSOR 7 - PROCESS A PSEUDO-LITERAL "[......]"
EVLP7: PUSH P,T1 ;SAVE ORIGINAL AC T1
MOVEI T1,4 ;GET 4 WORDS OF CORE
PUSHJ P,GETCOR ;FROM FREE MEMORY
PUSH P,T1 ;SAVE START ADDRESS AS START OF CHAIN
PUSH P,T1 ;SAVE START ADDRESS ACROSS EVALUTATION
EVLP7A: PUSHJ P,EVALS ;EVALUATE STATEMENT
SKIPE NULFLG ;DID LINE HAVE ANYTHING?
JRST [ CAIN CC,"]" ;NO,WASN'T CLOSING LINE WAS IT?
JRST QERROR ;YES,DON'T KNOW HOW TO HANDLE THAT
JRST EVLP7B ] ;ELSE JUST GET NEXT LINE
MOVE A,R%V ;RETURNED VALUE
MOVE B,R%R ;RETURNED RELOCATION
MOVE C,R%S ;RETURNED FIXUP
POP P,T1 ;GET POINTER TO 4-WORD BLOCK
MOVEM A,0(T1) ;WORD 0 GETS VALUE
MOVEM B,1(T1) ;WORD 1 GETS RELOCATION
MOVEM C,2(T1) ;WORD 2 GETS FIXUP
SETZM 3(T1) ;LINK TO NEXT BLOCK IS ZERO FOR NOW
TDNE B,[^-<1,,1>] ;CHECK FOR VALID RELOCATION
JRST RERROR ;BETTER TO GIVE ERROR MSG NOW
CAIN CC,"]" ;IS THIS CLOSE LITERAL?
JRST EVLP7C ;YES,SO GO FINISH UP
CAIN CC,";" ;INTO THE COMMENT FIELD?
PUSHJ P,FINLIN ;YES,SO FINISH UP THE LINE
CAIE CC,$EOL ;AT THE END OF THE LINE?
JRST QERROR ;NO, NOT ONE OF ($EOL, ; , ] ) IS ERROR
ADDI T1,3 ;T1 GETS POINTER TO LINK WORD OF BLOCK
PUSH P,T1 ;SAVE IT
MOVEI T1,4 ;GET NEXT BLOCK
PUSHJ P,GETCOR
MOVEM T1,@0(P) ;STORE THE LINK FROM PREV TO NXT
MOVEM T1,0(P) ;AND STORE THE BASE OF BLOCK
EVLP7B: PUSHJ P,MACLOD ;LOAD NEXT LINE
JRST EVLP7A ;AND EVALUATE IT
EVLP7C: PUSHJ P,ISTGET ;GET POINTER TO IST SLOT
POP P,0(C) ;WORD 1 OF PAIR IS POINTER TO 1ST
;BLOCK OF STRING OF BLOCKS
MOVX A,IS.LIT ;SET FLAGS IN WORD 2 OF PAIR
MOVEM A,1(C) ;
SETZ A, ;RETURN VALUE OF 0
MOVEI B,1 ;RELOCATED IN RH (WILL BE ADDRESS OF LITERAL)
MOVX D,C.LIT ;FLAG AS LITERAL
POP P,T1 ;RESTORE T1 TO ITS VALUE ON ENTRY
JRST ECELL ;END OF CELL
; PROCESSOR 8 -PROCESS A BRACKETED EXPRESSION "<.....>"
EVLP8: PUSHJ P,EVALS ;EVALUATE STATEMENT
CAIE CC,RABRKT ;RETURN VIA RIGHT A.BRACKET?
JRST QERROR ;NO,SO RETURN
MOVE A,R%V ;VALUE
MOVE B,R%R ;RELOCATION
SKIPN C,R%S ;GET IST POINTER
JRST EVLP8A ;IF NONE, MAKE NO CHECKS
MOVX T,IS.MWS ;DONT ALLOW MWS IN <> PAIR
TDNE T,1(C) ;CHECK RH OF FIXUP PAIR
JRST QERROR ;GIVE ERROR IF FOUND
EVLP8A: MOVX D,C.NUM ;NUMERIC
JRST ECELL ;END OF CELL
; PROCESSOR 9 - PROCESS THE CELL STARTING WITH . (PERIOD)
EVLP9: PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
EXCH CC,A ;PLACE WHERE TEST ROUTINES GET IT
SKPNUM ;A DIGIT FOLLOWS IT?
JRST .+2 ;NO
JRST EVLN1B ;PROCESS FLT PT NUMBER FRACTION
SKPR50 ;IN RADIX50 SET?
JRST .+3 ;NO
EXCH CC,A ;RESET CHARACTER AC
JRST EVLP2 ;PROCESS AS SYMBOL
MOVE A,CPADDR ;CURRENT LOCATION
MOVEI B,1 ;WHICH IS ADDRESS (IE RIGHT RELOC)
SETZ C, ;NO FORWARD REFERENCE
MOVX D,C.SYM ;ITS A SYMBOL
JRST ECELL ;DONE
; PROCESSOR 12 -PROCESS ^ (UP-ARROW) QUALIFIER.
EVLP12: BYPASS ;LOAD NEXT NON-BLANK CHARACTER
SETZ T, ;CLEAR RADIX
CAIN CC,"D" ;BASE 10.?
MOVEI T,^D10 ;YES,SET IT
CAIN CC,"B" ;BASE 2.?
MOVEI T,^D2 ;YES,SET IT
CAIN CC,"O" ;BASE 8.?
MOVEI T,^D8 ;YES,SET IT
CAIN CC,"F" ;DECIMAL FRACTION?
$KILL(FNI,Qualifier ^F not implemented)
CAIN CC,"L" ;JFFO INST?
JRST EVP12A ;YES,GO HANDLE IT
CAIN CC,"-" ;UNARY .NOT. ?
JRST EVP12B ;YES,GO HANDLE IT
JUMPE T,NERROR ;IF HERE WITH T=0,ITS ERROR
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEM T,CRADIX ;AND REPLACE IT WITH OURS
PUSHJ P,CELL ;GET NEXT CELL,UNDER THIS RADIX
POP P,CRADIX ;RESET RADIX
TXNE D,C.NULL ;ILLEGAL TO QUALIFY NOTHING
JRST QERROR ;
EVP12Z: TXNN D,C.NUM ;WAS GOTTEN CELL A NUMBER?
JRST NERROR ;NO,COMPLAIN
JRST ECELL ;ELSE RETURN
; ^L PROCESSOR
EVP12A: PUSHJ P,CELL ;GET FOLLOWING CELL
TXNE D,C.NULL
JRST QERROR
JUMPN C,FERROR ;IF FORWARD REFERENCE , CANT HANDLE
JFFO A,.+2 ;COUNT ZEROES TO FIRST 1
MOVEI B,^D36 ;IF WHOLE WORD IS ZERO
MOVE A,B ;RETURNED VALUE IS RESULT
SETZ B, ;AND IT IS NOT RELOCATED
JRST EVP12Z ;RETURN
; ^- PROCESSOR
EVP12B: PUSHJ P,CELL ;GET CELL
TXNE D,C.NULL
JRST QERROR
JUMPN C,FERROR ;CANT HANDLE FORWARD REFERENCE
JUMPN B,RERROR ;ERROR IF ITS RLOCATABLE
SETCA A, ;COMPLEMENT AC A (AC A,YOU'RE GREAT)
JRST EVP12Z ;AND FINISH,WITH USUAL CHECKS
; PROCESSOR 13 - PROCESS RIGHT ANGLE BRACKET
EVLP13: SKIPE NSTLVL ;DONT MAKE LEVEL NEGATIVE
SOSA NSTLVL ;MATCHING OPEN BRACKETS?
JRST NCELL ;NO, SO LEAVE IT HERE
TXZ F,REGET ;EAT THIS CHARACTER
BYPASS
JRST NCELL ;AND CLAIM ITS NULL CELL
; PROCESSORS 70-89 ARE RESERVED FOR PSEUDO-OPERATORS
;
;
; PROCESSOR 70 - PROCESS THE PSEUDO-OPERATOR 'ASCII'
EVP70: MOVE C,[POINT 7,A] ;POINTER TO VALUE
MOVE D,[POINT 7,5] ;D GETS XWD PTR,BYTES PER WORD
SETZB A,WRDCNT ;CLEAR VALUE AND WORD COUNT
BYPASS ;GET DELIMITER
CAIN CC,$EOL ;IS IT END OF LINE?
JRST QERROR ;YES,RETURN ERROR
MOVEM CC,T ;SAVE DELIMITER
MOVEI B,5 ;BYTE COUNTER
TXO F,QUOTE ;NO CHARACTER CONVERSION
EVP70A: PUSHJ P,MIC ;INPUT THE BYTE
CAMN CC,T ;A MATCH ON DELIMITER?
JRST EVP70D ;YES, END IT
PUSHJ P,NWCHK ;SEE IF NEW WORD NEEDED
CAIE CC,$EOL ;IS THIS AN END OF LINE?
JRST EVP70B ;NO
PUSHJ P,MACLOD ;YES,SO LOAD NEXT LINE
MOVE CC,REOL ;RESTORE REAL END OF LINE
EVP70B: IDPB CC,C ;STORE THE CHARACTER
JRST EVP70A ;AND BACK FOR MORE
; PROCESSOR 71 - PROCESS THE PSEUDO-OPERATOR 'SIXBIT'
EVP71: MOVE C,[POINT 6,A] ;POINTER TO VALUE
MOVE D,[POINT 6,6] ;D GETS PTR,,BYTES PER WORD
SETZB A,WRDCNT ;CLEAR VALUE,,OVERFLOW COUNT
BYPASS ;GET DELIMITER
CAIN CC,$EOL ;IS IT END OF LINE?
JRST QERROR ;YES,RETURN ERROR
MOVEM CC,T ;SAVE DELIMITER
MOVEI B,6 ;CURRENT BYTE COUNT
EVP71A: PUSHJ P,MIC ;INPUT THE BYTE
CAMN CC,T ;A MATCH ON DELIMETER?
JRST EVP70D ;YES , SO END IT
PUSHJ P,NWCHK ;SEE IF NEW WORD NEEDED
SUBI CC," "-' ' ;CONVERT TO SIXBIT
JUMPL CC,AERROR ;IF NO SIXBIT REPRESENTATION
IDPB CC,C ;STORE THE CHARACTER
JRST EVP71A ;AND BACK FOR MORE
EVP70D: TXZN %F,S.ASCZ ;HERE ON END OF STRING. SPECIAL ASCIZ ?
JRST EVP70E ;NO, DONT END WITH NULL
SETZ CC, ;YES, GET A NULL TO DEPOSIT
PUSHJ P,NWCHK ;MAY CAUSE NEW WORD
IDPB CC,C ;DEPOSIT IT
EVP70E: TXZ F,QUOTE ;NO MORE QUOTED STRING
MOVX D,C.NUM ;NUMERIC
SETZ C, ;NO FIXUP
SKIPN B,WRDCNT ;WAS IT MORE THAN ONE WORD?
JRST ECELL ;NO,JUST RETURN
PUSHJ P,ISTGET ;GET SLOT ON IST
HLRZM B,0(C) ;STORE ADDRESS OF STRING IN RH OF WORD 1
HRRZS B ;WORD COUNT ALONE NOW
MOVNS B ;NEGATE IT
HRLM B,0(C) ;WORD 1/ -COUNT,,ADDRESS
MOVX B,IS.MWS ;FLAG TYPE OF ENTRY
MOVEM B,1(C) ;AND STORE IT
SETZ B, ;NOT RELOCATED
JRST ECELL ;END OF THIS CELL
;HERE TO CHECK FOR NEW WORD NEEDED
;NOTE- DONT CALL GETCOR DURING
;STRING EVALUATION,EXCEPT HERE
NWCHK: SOJGE B,CPOPJ ;IF COUNT OK,JUST RETURN
PUSH P,T1 ;SAVE AC
MOVEI T1,1 ;GET WORD
PUSHJ P,GETCOR ;ALLOCATE IT
HRRZ C,T1 ;RH OF NEW BYTE POINTER
HLL C,D ;LH OF NEW BYTE POINTER
MOVEI B,-1(D) ;ALSO RESET COUNT,ADJ BY 1
SKIPN WRDCNT ;IF FIRST OVERFLOW,
HRLZM T1,WRDCNT ;STORE THE STRING'S ADDRESS
AOS WRDCNT ;UPDATE COUNT
PJRST T1POPJ ;RESTORE T1,RETURN
; PROCESSOR 70Z - PROCESS THE PSEUDO-OPERATOR 'ASCIZ'
;
EVP70Z: TXO %F,S.ASCZ ;TURN ON FLAG BIT
JRST EVP70 ;NOW GO HANDLE LIKE ASCII
; PROCESSOR 72 - PROCESS THE PSEUDO-OPERATOR 'IOWD'
; PROCESSOR 73 - PROCESS THE PSEUDO-OPERATOR 'XWD'
EVP72: SKIPA T,[P.IOWD] ;FLAG AS IOWD PSEUDO-OP
EVP73: MOVX T,P.XWD ;
TDOE %F,T ;TURN ON BIT,TEST FOR DUPLICATE
JRST QERROR ;THIS IS LEGAL BUT WE DONT HANDLE IT
JRST CELL ;PROCESS MORE OF THE CELL
; PROCESSOR 74 - PROCESS THE PSEUDO OPERATORS 'SQUOZE' & 'RADIX50'
EVP74: PUSHJ P,EVALEX ;READ IN AND EVALUATE BITS
SKPNCM ;END WITH COMMA?
TDNE A,[^-74] ;AND PROPER VALUE?
JRST QERROR ;NO,FAILS SYNTAX CHECK
JUMPN B,RERROR ;CANT BE RELOCATABLE
JUMPN C,FERROR ;OR UNKNOWN/EXTERNAL
LSH A,^D30 ;GET IT INTO BITS 0-3
PUSH P,A ;SAVE THE CODE BITS AWAY
TXZ F,REGET ;DONT EAT THE , AGAIN
PUSHJ P,SYMIN ;READ THE SYMBOL IN
MOVE R,A ;GET INTO ARG FOR RAD50
PUSHJ P,RAD50 ;CONVERT TO RADIX50
IORM R,0(P) ;MERGE BITS AND SYMBOL
POP P,A ;VALUE OF CELL TO RETURN
SETZB B,C ;NO RELOC OR FIXUP
MOVX D,C.NUM ;TAG AS NUMBER
TXO F,REGET ;REGET SYMBOL DELIMITER
JRST ECELL ;AND END THE CELL
; PROCESSOR 75 - PROCESS THE PSEUDO-OPERATOR 'POINT'
EVP75: PUSH P,[0] ;PUSH 3 PLACE HOLDERS ON STACK
PUSH P,[0]
PUSH P,[<^D36>B5] ;DEFAULT BYTE POSITION
PUSHJ P,EVLX10 ;GET BYTE SIZE IN RADIX 10.
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;AND KNOWN
DPB A,[POINT 6,0(P),11] ;STORE THE BYTE SIZE
SKPCM ;DELIMITED BY COMMA?
JRST EVP75A ;NO,SO WE ARE DONE
TXZ F,REGET ;INSURE WE DONT SEE THAT COMMA AGAIN
PUSHJ P,EVADR ;EVALUATE ADDRESS
DPB A,[POINT 23,0(P),35] ;DEPOSIT ADDRESS
MOVEM B,-1(P) ;STORE RELOCATION
MOVEM C,-2(P) ;AND THE FIXUP
SKPCM ;END WITH COMMA?
JRST EVP75A ;NO,DONE
TXZ F,REGET ;DONT GET THE COMMA AGAIN
PUSHJ P,EVLX10 ;EVALUATE BYTE POSITION
TXNE D,C.NULL ;WAS ANYTHING THERE?
JRST EVP75A ;NO
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;AND KNOWN
MOVEI T,^D35 ;TRANSLATE TO HARDWARE POSITION
SUB T,A ;
JUMPL T,QERROR ;CALL THIS AN ERROR
DPB T,[POINT 6,0(P),5] ;UPDATE BYTE POSITION
EVP75A: POP P,A ;RETURN VALUE
POP P,B ;RETURN RELOCATION OF POINTER
POP P,C ;RESTORE FIXUP WORD
MOVX D,C.NUM ;CALL IT A NUMBER
JRST ECELL ;EXIT THE CELL
; PROCESSOR 76 - PROCESS THE PSEUDO-OPERATOR 'COMMENT'
EVP76: BYPASS ;GET FIRST NON-BLANK CHARACTER
CAIN CC,$EOL ;ERROR IF ITS END OF LINE
JRST QERROR
MOVEM CC,T ;SAVE DELIMITER
EVP76A: PUSHJ P,MIC ;LOAD BYTE FROM INPUT
CAIN CC,$EOL ;IS IT END OF LINE?
JRST [ PUSHJ P,MACLOD ;THE NEXT LINE
JRST EVP76A] ;AND GET BYTE, ETC..
CAME CC,T ;MATCHES DELIMITER?
JRST EVP76A ;NO
JRST CELL ;
; PROCESSOR 77 - PROCESS THE PSEUDO-OPERATOR 'REMARK'
EVP77: PUSHJ P,MIC ;GET A CHARACTER
CAIE CC,$EOL ;END OF LINE?
JRST EVP77 ;NO,TRY AGAIN
JRST NCELL ;YES,EOL SEEN,SO CALL IT NULL CELL
; PROCESSOR 78 - PROCESS THE PSEUDO-OPERATOR 'EXP'
EVP78: PUSHJ P,EVALEX ;EVALUATE EXPRESSION
EVP78A: MOVX D,C.NUM ;FLAG AS NUMERIC
SKPCM ;IF NOT COMMA,
JRST ECELL ;ITS END OF CELL
JRST WERROR ;ELSE TOO MANY WORDS FOR CURRENT
; PROCESSOR 79 - PROCESS THE PSEUDO-OPERATOR 'DEC'
EVP79: PUSHJ P,EVLX10 ;EVALUATE EXPRESSION USING RADIX 10.
JRST EVP78A ;MAKE CHECKS
; PROCESSOR 80 - PROCESS THE PSEUDO-OPERATOR 'OCT'
EVP80: PUSH P,CRADIX ;STORE CURRENT RADIX
MOVEI A,^D8 ;SET IT AS BASE (8)
MOVEM A,CRADIX ;
PUSHJ P,EVALEX ;EVALUATE EXPRESSION
POP P,CRADIX ;AND RESTORE RADIX
JRST EVP78A ;MAKE COMMON CHECKS
; PROCESSOR 81 - PROCESS THE PSEUDO-OPERATOR 'BYTE'
EVP81: REPEAT 3,<PUSH P,[0]> ;MAKE ROOM FOR CODE TRIPLET
PUSH P,[POINT 0,0(P)] ;STORE BYTE POINTER
BYPASS ;GET FIRST NON-BLANK
CAIE CC,"(" ;MUST START WITH BYTE SIZE
JRST AERROR ;BUT ITS NOT
EVP81A: PUSHJ P,EVLX10 ;READ EXPRESSION IN DECIMAL
JUMPN B,RERROR ;CANT BE RELOCATABLE
JUMPN C,FERROR ;OR UNKNOWN
CAIE CC,")" ;END IN MATCHING R PARENS?
JRST AERROR ;NO,SO FLAG ERROR
CAILE A,0 ;IF NOT IN RANGE 1-36 (10.)
CAILE A,^D36 ;
JRST AERROR ;FLAG ERROR
DPB A,[POINT 6,0(P),11] ;STORE SIZE INTO POINTER
EVP81B: TXZ F,REGET ;DONT REGET THE R PARENS
PUSHJ P,EVALEX ;EVALUATE THE EXPRESSION
IBP 0(P) ;INCREMENT THE BYTE POINTER
SKIPN B ;MAKE SURE IF FIXUP OR RELOC
SKIPE C ;THAT BYTE ALIGNED ON BOUNDARY
JRST [ LDB T,[POINT 6,0(P),11] ;GET SIZE
CAIE T,^D36 ;MUST BE 18. OR 36.
CAIN T,^D18 ;ELSE ITS ERROR
JRST .+1 ;
JRST RERROR ] ;DONE
MOVE T,0(P) ;PICK UP THE POINTER
TRNE T,-1 ;IF INTO NEXT WORD,CANT HANDLE
JRST WERROR ;BECAUSE IT GENERATES MULTI-WORD
HRRI T,-1 ;STORE VALUE INTO -1(P)
DPB A,T ;
HRRI T,-2 ;STORE RELOC INTO -2(P)
DPB B,T ;
HRRI T,-3 ;STORE SYMFIX INTO -3(P)
DPB C,T ;
SKPNCM ;COMMA DELIMITS EXPRESSION?
JRST EVP81B ;YES,GET NEXT PIECE
CAIN CC,"(" ;IS IT L PARENS?
JRST [TXZ F,REGET ;YES,CHANGE BYTE SIZE
JRST EVP81A] ;AFTER EATING THE "("
POP P,0(P) ;CLEAR BP OFF STACK
POP P,A ;SET UP EXPRESSION
POP P,B ;
POP P,C
MOVX D,C.NUM ;FLAG NUMERIC
JRST ECELL ;END OF CELL
; PROCESSOR 82 - PROCESS THE PSEUDO-OPERATOR 'RADIX'
EVP82: PUSHJ P,EVLX10 ;EVALUATE EXPRESSION USING BASE 10.
JUMPN B,RERROR ;MUST BE ABSOLUTE AND
JUMPN C,FERROR ;MUST BE KNOWN
CAIL A,2 ;AND IT MUST BE IN RANGE 2-10
CAILE A,^D10 ;
JRST AERROR ;ELSE ITS AN ARG ERROR
MOVEM A,CRADIX ;CHANGE RADIX
JRST MECELL ;MUST END LINE WITH THIS CELL
; PROCESSOR 83 - HANDLE THE IFXX CONDITIONALS: IFXX EXP,< STUFF...>
EVP83: ;ALL IFXX CONDITIONALS
EVP83A: AOS IFIDX ;IFN CONDITIONAL
EVP83B: AOS IFIDX ;IFE CONDITIONAL
EVP83C: AOS IFIDX ;IFL CONDITIONAL
EVP83D: AOS IFIDX ;IFG CONDITIONAL
EVP83E: AOS IFIDX ;IFLE CONDITIONAL
EVP83F: ;IFGE CONDITIONAL
PUSHJ P,EVALEX ;EVALUATE EXPRESSION
JUMPN C,FERROR ;IF FORWARD OR EXTERNAL, ITS ERROR
EVP83K: SKPCM ;DELIMITED BY COMMA?
JRST QERROR ;NO, STOP NOW
TXZ F,REGET ;EAT THE COMMA
EVP83M: BYPASS ;AND GET NEXT NON-BLANK
CAIE CC,LABRKT ;IS IT A LEFT ANGLE BRACKET?
JRST [ CAIE CC,$EOL ;NO. IS IT END OF LINE?
JRST QERROR
PUSHJ P,MACLOD ;LOAD NEW LINE
JRST EVP83M ] ;AND TRY AGAIN
SETZ D, ;CLEAR A REGISTER
EXCH D,IFIDX ;GET INDEX AND CLEAR INDEX
XCT IFTST(D) ;DO THE PROPER TEST
AOS NSTLVL ;TEST SUCCEEDED. BUMP COUNT
JRST CELL ;AND PRETEND WE WEREN'T HERE
EVP83L: PUSHJ P,MIC ;GET A CHARACTER
CAIN CC,LABRKT ;ANOTHER LEFT ANGLE BRACKET?
AOJA C,EVP83L ;YES, WE ARE DEEPER AND CONTINUE
CAIN CC,RABRKT ;A RIGHT ANGLE BRACKET?
SOJA C,[ JUMPGE C,EVP83L ;UPDATE COUNT. DONE?
JRST CELL ] ;YES, CONTINUE FROM HERE
CAIN CC,$EOL ;IS IT THE END OF THE LINE
PUSHJ P,MACLOD ;YES, LOAD NEXT LINE
JRST EVP83L ;AND TRY AGAIN
EVP83G: AOS IFIDX ;IFDEF, SET INDEX TO IFLE
EVP83H: PUSHJ P,IFSYM ;IFNDEF, GET SYMBOL LOADED
MOVEM A,R ;INTO SEARCH INPUT PLACE
PUSHJ P,SYMSRC ;LOOK IT UP
SKIPA A,[1] ; 1 IF NOT DEFINED
SETO A, ;-1 IF DEFINED
JRST EVP83K ;JOIN COMMON CODE
EVP83P: AOS IFIDX ;IFEDIT ENTRY
EVP83Q: PUSHJ P,IFSYM ;IFNEDIT , LOAD SYMBOL
PUSHJ P,FNDEDT ;LOOK UP THE EDIT TO SEE IF THERE
SKIPA A,[1] ;NOT THERE, CREATE POS. VALUE
SETO A, ;THERE, CREATE NEG. VALUE
JRST EVP83K ;JOIN COMMON CODE
EVP83R: AOS IFIDX ;IFACTIVE ENTRY
EVP83S: PUSHJ P,IFSYM ;IFNACTIVE ENTRY
PUSHJ P,FNDEDT ;LOOK UP THE EDIT
JRST AERROR ;IF NOT THERE, ITS ERROR
SKIPL A,TB$STA(B) ;IS IT ACTIVE?
MOVEI A,1 ;NO, POS. VALUE INDICATES INACTIVE
JRST EVP83K ;JOIN COMMON CODE
IFSYM: CAIE CC," " ;WAS DELIMITER A SPACE?
JRST QERROR ;NO
BYPASS ;GET FIRST NON-BLANK
TXO F,REGET ;AND START THAT AS SYMBOL
PUSHJ P,SYMIN ;LOAD THE SYMBOL
JUMPE A,AERROR ;IF NOT THERE, FLAG THE ERROR
TXO F,REGET ;START WITH THIS CHARACTER
BYPASS ;AND EAT TRAILING SPACES
POPJ P, ;RETURN
IFTST: JUMPL A,EVP83L ;IFGE TEST
JUMPG A,EVP83L ;IFLE TEST
JUMPLE A,EVP83L ;IFG TEST
JUMPGE A,EVP83L ;IFL TEST
JUMPN A,EVP83L ;IFE TEST
JUMPE A,EVP83L ;IFN TEST
; PROCESSOR 84 - PROCESS THE PSEUDO-OPERATOR 'PURGE'
EVP84: PUSHJ P,.PSH4T## ;SAVE T1-4
EVP84A: BYPASS ;GET FIRST ARGUMENT
TXO F,REGET ;STARTING WITH FIRST NON-BLANK
PUSHJ P,SYMIN ;LOAD SYMBOL NAME
JUMPE A,AERROR ;IF NOT R50 SYMBOL, BAD ARGUMENT
MOVE R,A ;INPUT ARG TO SYMSRC
PUSHJ P,SYMSRC ;LOOK THE SYMBOL UP
JRST EVP84C ;MACRO ALLOWS PURGE OF NON-DEFINED SYMBOL
CAIE B,60 ;IS THIS A GLOBAL SYMBOL?
JRST EVP84B ;NO, ALL IS OK
MOVE N,R ;GIVE WARNING SINCE CHAIN MAY BE
$WARN(PES,Purging EXTERNAL symbol,N$SIX,$MORE) ;DESTROYED
MOVEI T1,[ASCIZ / may give bad REL file /]
PUSHJ P,.TSTRG## ;OUTPUT REST OF MESSAGE
PUSHJ P,SAYED1 ;SAY "IN EDIT BLAH"
X$$PES: PUSHJ P,.TCRLF##
TXZ F,FOTTY
EVP84B: MOVE T1,[RADIX50 10,.] ;SET IMPOSSIBLE SYMBOL NAME,MAKE IT LOCAL
MOVEM T1,0(C) ;STORE IT OVER EXISTING SYMBOL NAME
SETZM 1(C) ;CLEAR VALUE TOO
PUSHJ P,SYMSRN ;SEE IF MORE OCCURENCES OF SAME SYMBOL
SKIPA
JRST EVP84B ;YES,PROCESS THEM
EVP84C: TXO F,REGET ;STARTING WITH CURRENT DELIMITER
BYPASS ;GET NEXT NON-BLANK CHARACTER
SKPNCM ;COMMA?
JRST EVP84A ;YES, GET NEXT ARGUMENT
PUSHJ P,.POP4T## ;ELSE RESTORE TEMP ACS
JRST MECELL ;AND RETURN
; PROCESSOR 85 - PROCESS THE PSEUDO-OPERATOR 'BLOCK'
;
; NOTE: A TRUE "BLOCK" OPERATION IS NOT PERFORMED, INSTEAD A MULTIPLE WORD
; STRING OF 0 WORDS IS GENERATED TO SIMULATE BLOCK TYPE ACTION
EVP85: PUSHJ P,EVALEX ;EVALUATE ARGUMENT TO OPERATOR
JUMPN B,RERROR ;CANT BE RELOCATABLE
JUMPN C,FERROR ;OR UNKNOWN
JUMPLE A,AERROR ;DON'T ALLOW BLOCK 0 OR NEGATIVE ARG
CAIN A,1 ;WAS THIS A BLOCK 1?
JRST EVP85A ;YES,NO NEED FOR MULTIPLE GENERATION
PUSHJ P,ISTGET ;GET A SLOT FROM THE IST
MOVNI A,-1(A) ;ADJUST COUNT,NEGATE IT
HRLZM A,0(C) ;STORE -COUNT,,0 FOR PMMWS
MOVX A,IS.MWS+IS.BLK ;FLAG AS BLOCK TYPE OF MULTI-WORD
MOVEM A,1(C) ;STRING GENERATION
EVP85A: SETZB A,B ;CLEAR RESULT
MOVX D,C.NUM ;RETURN FIRST WORD NOW AS 0
JRST ECELL ;END THE CELL
; /FP.EDT/ - THIS FIX PSEUDO-OP TAKES AS AN ARGUMENT THE EDIT NAME,
; WHICH CAN BE UP TO SIX RADIX-50 CHARACTERS LONG.
; IT ALSO ALLOCATES THE STATIC AREA FOR THE TRACE BLOCK
; AND RESETS THE INTERIM SYMBOL TABLE
;
;
FP.EDT: PUSHJ P,.PSH4T## ;SAVE ACS
TXNE F,IAE ;INSIDE AN EDIT?
JRST [MOVE N,CUREDT
$KILL(MEP,Missing .ENDE for edit,N$SIX)]
BYPASS ;SKIP OVER BLANKS
TXO F,REGET ;AND REGET FIRST NON-BLANK
PUSHJ P,SYMIN ;GET EDIT NUMBER
JUMPE A,[$KILL(NEI,Null argument to .EDIT is illegal)]
TXO F,IAE!FSTMOD ;INSIDE EDIT,FIRST MODULE THIS EDIT
MOVEM A,CUREDT ;STORE CURRENT EDIT NAME
SETZM CPPART ;RESET EDIT PART ID
PUSHJ P,ISTINI ;RESET IST
MOVE T1,TRCVAP ;MAKE TRACE BLOCK FOLLOW
MOVEM T1,TRCPTR ;LAST ONE
CAILE T1,TRCLST-TB$SIZ ;ROOM LEFT?
$KILL(ITS,Insufficient TRACE block storage,N$EDIT)
MOVE T2,[LI$TRC,,TB$SIZ] ;PICK UP A HEADER
MOVEM T2,TB$HED(T1) ;STORE IT
MOVEM A,TB$EDT(T1) ;STORE CURRENT EDIT NAME
MOVE T2,WHO ;AND OUR INITIALS
HRROM T2,TB$STA(T1) ;DEPOSIT AND MARK ACTIVE
HRLM T2,TB$INS(T1) ;ALSO AS PERSON INSTALLING
DATE T2, ;GET SYSTEM DATE
HRRM T2,TB$INS(T1) ;DEPOSIT DATE INSERTED
SETZM TB$LEN(T1) ;ZERO THE VAR. AREA LENGTH
SETZM TB$MAK(T1) ;ZERO THE CREATION DATE/INITIALS
MOVEI T2,TB$VAR(T1) ;START OF VARIABLE AREA
MOVEM T2,TRCVAP ;STORED
PUSHJ P,.POP4T## ;RESTORE ACS
JRST MECELL ;MUST END CELL
; /FP.MOD/- ROUTINE TO GET THE NAME OF MODULE TO BE PATCHED AND THEN
; EITHER RETURN TO DISPATCH (IF ALREADY IN CORE) OR
; ELSE SEARCH FOR IT IN THE REL FILE. NOTE THAT WE
; CAN SEARCH BACFPARDS HERE BUT GIVE AN ERROR MESSAGE
; IF THE MODULE IS NOT FOUND AT ALL.
FP.MOD: PUSHJ P,.PSH4T## ;SAVE ACS
TXNN F,IAE ;IN ACTIVE EDIT?
$KILL(EPM,.EDIT pseudo-op is missing from FIX file)
BYPASS ;
TXO F,REGET
PUSHJ P,SYMIN ;GET THE MODULE NAME
SKIPN A ;IF NO MODULE NAME GIVEN,
$KILL(NMS,Null specification to .MODULE,N$EDIT)
CAMN A,CURMOD ;SAME MODULE NAME AS ONE IN CORE?
JRST MOD5 ;YES, JUST MAKE CHECKS
PUSHJ P,UDFCHK ;CHECK FOR UNDEFINED LABELS
MOVEM A,CURMOD ;MAKE THIS MODULE BE CURRENT
PUSHJ P,PUTPG ;UNLOAD PROGRAM IN CORE
PUSHJ P,MSTGET ;SET UP IO ROUTINES
JFCL ;DONT CARE
MOVE R,CURMOD ;GET MODULE NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
TXZ F,CPASS2 ;FIRST PASS
MOD2: PUSHJ P,READ ;READ A PROGRAM
JRST [ TXOE F,CPASS2 ;EOF. ARE WE DOING 2ND PASS?
JRST MNFERR ;YES,REALLY NOT THERE
PUSHJ P,BACKUP ;REWIND THE FILES
JRST MOD2 ] ;AND MAKE 2ND PASS
CAMN R,A ;IS THIS THE RIGHT MODULE?
JRST MOD3 ;YES!
PUSHJ P,WRITE ;NO, SO WRITE IT OUT
JRST MOD2 ;AND TRY AGAIN
MOD3: PUSHJ P,YANKPG ;YANK ALL OF PROGRAM INTO CORE
JRST [MOVE N,R
$KILL(EFF,End of file found before END block in module,N$50)]
MOVE N,CURMOD ;SET MODULE NAME INTO TYPEOUT
SKIPN SSTLOC ;SYMBOLS FOUND?
$WARN (SNF,Symbols not found for module,N$SIX)
SKIPN SPCLOC ;ANY PROGRAM CODE?
$WARN (NPC,No program code was found for module,N$SIX)
MOD5: TXZ F,FSTMOD ;SEEN A .MODULE SINCE LAST .EDIT
MOVE A,CUREDT ;SEE IF THIS MODULE HAS THIS EDIT
PUSHJ P,FNDEDT ;ALREADY. THIS IS AN ERROR
JRST MOD6 ;NO. ITS OK, EDIT NOT THERE
MOVE N,CURMOD ;BLOW THEM AWAY
$KILL (MHE,Module,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ already has an edit /]
PUSHJ P,.TSTRG## ;FINISH MESSAGE
MOVE T1,CUREDT ;IDENTIFY EDIT
PUSHJ P,.TSIXN## ;
JRST DONERR ;END MESSAGE
MOD6: MOVE A,CUREDT ;SEE IF THERE ARE CONFLICTS
MOVSI B,400000 ;WITH THIS EDIT BEING INSERTED
PUSHJ P,CHKCNF ;
PUSHJ P,.POP4T## ;RESTORE ACS
JRST MECELL ;END OF CELL,I HOPE
; /FP.ASC/ - FIX-PSEUDO-OP PROCESSOR FOR LINE OF FORM:
; .ASSOCIATED EDIT,+EDIT,-EDIT,EDIT,+EDIT.... ;ASSOC. EDITS
;
; NOTE THAT A .MODULE FIX-PSEUDO-OP MUST BE PRESENT
; BEFORE THE .ASSOCIATE FIX-PSEUDO-OP, TO SELECT THE CURRENT MODULE
;
FP.ASC: PUSHJ P,.PSH4T## ;FREE SOME ACS
TXNN F,IAE ;INSIDE AN ACTIVE EDIT?
JRST E$$EPM ;NO,COMPLAIN
TXNE F,FSTMOD ;[MODULE]SEEN YET?
JRST MKMERR ;NO,COMPLAIN
MOVE D,TRCVAP ;GET POINTER TO VARIABLE AREA
ASC1: BYPASS ;SKIP OVER BLANKS
MOVE N,CUREDT ;SET UP FOR EDIT NAME
SETZ T4, ;MARK FOR "-" ASSOCIATION
CAIN CC,"-" ;IS IT?
JRST ASC2 ;YES
MOVSI T4,400000 ;SET FOR "+" ASSOCIATION
CAIE CC,"+" ;EXPLICIT?
TXO F,REGET ;NO,IMPLIED,REGET FIRST CHAR
ASC2: PUSHJ P,SYMIN ;LOAD EDIT NAME
JUMPE A,AERROR
MOVE T1,TRCPTR ;GET POINTER
HRRZ T2,TB$LEN(T1) ;GET RH OF LENGTH
JUMPN T2,[$KILL(AAC,<.ASSOCIATED seen after .INSERT,.REMOVE or .REINSERT>,N$EDIT)]
MOVSI T2,1 ;ADD 1 TO LH OF TB$LEN
ADDM T2,TB$LEN(T1) ;FOR A.E. COUNT
AOS TB$HED(T1) ;UPDATE WORD COUNT
AOS TB$HED(T1) ;BY TWO FOR AN A.E.
CAILE D,TRCLST-1 ;ROOM FOR THIS A.E.?
JRST E$$ITS ;NO,COMPLAIN
MOVEM A,TB$AEN(D) ;STORE ASSOCIATED NAME
MOVEM T4,TB$AES(D) ;AND REQUIRED STATUS
ADDI D,2 ;UPDATE POINTER
MOVEM D,TRCVAP ;AND STORE IT
PUSHJ P,FNDEDT ;LOOK IT UP
JRST ASC3 ;NOT FOUND
SKIPL TB$STA(B) ;WAS FOUND, IS IT ACTIVE?
JRST ASC3A ;NO
JUMPL T4,ASC4 ;IS ACTIVE, WANTED ACTIVE?
MOVE N,A ;WARN
$WARN(PEP,Precluded edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ is present in module /]
ASC2A: PUSHJ P,.TSTRG## ;REST OF MESSAGE
MOVE T1,CURMOD ;GET MODULE NAME
PUSHJ P,.TSIXN## ;
X$$PEP:X$$REM:
X$$RER: PUSHJ P,.TCRLF## ;CLOSE MESSAGE
TXZ F,FOTTY ;
JRST ASC4
ASC3: JUMPGE T4,ASC4 ;IS NOT ACTIVE.WANTED THIS?
MOVE N,A ;YES,SO WARN THAT ISNT THERE
$WARN(REM,Required edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ is missing from module /]
JRST ASC2A
ASC3A: JUMPGE T4,ASC4 ;THERE BUT INACTIVE,WANTED THIS?
MOVE N,A ;NO,GIVE WARNING
$WARN(RER,Required edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " is inactive in module "]
JRST ASC2A
ASC4: TXO F,REGET ;STARTING WITH DELIMITER OF EDIT NAME,
BYPASS ;GET NEXT NON-BLANK CHARACTER
SKPNCM ;IS IT A COMMA?
JRST ASC1 ;YES,INDICATES ANOTHER EDIT
PUSHJ P,.POP4T## ;RESTORE THE ACS
JRST MECELL ;AND RETURN
SAYEDT: PUSHJ P,.TSPAC## ;SEPARATE BY ONE SPACE
PUSHJ P,SAYED1 ;CALL COMMON ROUTINE
PUSHJ P,.TCRLF##
JRST DONERR
SAYED1: MOVEI T1,[ASCIZ "in edit "]
PUSHJ P,.TSTRG##
MOVE T1,CUREDT
PJRST .TSIXN##
; /FP.NAM/ - PSEUDO-OP TO GET THE PATCH CREATOR'S
; INITIALS OUT OF THE PATCH FILE
; .NAME III ;PERSON WHO CREATED THE PATCH
;
FP.NAM: TXNN F,IAE ;IN AN EDIT
JRST E$$EPM ;NO, COMPLAIN
BYPASS ;LOAD INITIALS FROM
TXO F,REGET ;INPUT FILE, INDICATES
PUSHJ P,SYMIN ;PATCH CREATOR NAME
MOVE D,TRCPTR ;AND GET POINTER
HLLM A,TB$MAK(D) ;SET IT DOWN
JRST MECELL ;
; /FP.DAT/ - GET THE DATE OF THE PATCH FROM THE PSEUDO-OP .DATE
;
; FORMAT: .DATE DD-MON-YY ;THIS IS THE DATE OF THE THING
; .DATE DD-MON ;OR DEFAULT THE YEAR
FP.DAT: PUSHJ P,.PSH4T## ;SAVE ACS T1-4
BYPASS ;SKIP BLANKS BEFORE ARGUMENT
TXO F,REGET ;
PUSHJ P,DECIN ;GET A DECIMAL NUMBER
JUMPE A,[$KILL(BDA,Bad .DATE argument)]
CAIE CC,"-" ;SPECIAL SEPARATOR
JRST E$$BDA ;ELSE COMPLAIN
PUSH P,A ; STORE IT
PUSHJ P,SYMIN ;GET MONTH NAME
MOVE T1,[IOWD ^D12,MTAB] ;GET POINTER TO TABLE
MOVE T2,A ;WHAT TO LOOK FOR
PUSHJ P,.LKNAM## ;HOW TO LOOK
JRST E$$BDA ;BAD FORMAT
HRRZ B,T1 ;GET RH
SUBI B,MTAB ;AND GET INTO PROPER RELATIVE
CAIN CC,"-" ;DASH?
JRST DAT1 ;YES, YEAR SUPPLIED
DATE T2, ;GET DATE RIGHT NOW
IDIVI T2,^D12*^D31 ;ONLY INTERESTED IN YEAR
JRST DAT2 ;SKIP THE READ IN
DAT1: PUSHJ P,DECIN ;GET YEAR
MOVE T1,A ;GET FROM ARG AC
IDIVI T1,^D100 ;MAKE 2 DIGIT
SUBI T2,^D64 ;SINCE 1964
JUMPE T2,E$$BDA ;IF .LE. 0
DAT2: IMULI T2,^D12 ;MULTIPLY TO GET RIGHT
ADD T2,B ;ADD THE (MONTH-1)
IMULI T2,^D31 ;GET OVER
ADD T2,0(P) ;ADD IN PARTIAL RESULT
SOS T2 ;ADJUST FOR THE MINUS ONE
POP P,0(P)
MOVE T3,TRCPTR ;STORE IN STATIC AREA OF TRACE BLOCK
HRRM T2,TB$MAK(T3) ;
PUSHJ P,.POP4T## ;RESTORE T1-T4
JRST MECELL ;END IT
MTAB: SIXBIT/JANUAR/ ;TABLE OF MONTHS OF THE YEAR
SIXBIT/FEBRUA/
SIXBIT/MARCH/
SIXBIT/APRIL/
SIXBIT/MAY/
SIXBIT/JUNE/
SIXBIT/JULY/
SIXBIT/AUGUST/
SIXBIT/SEPTEM/
SIXBIT/OCTOBE/
SIXBIT/NOVEMB/
SIXBIT/DECEMB/
; /FP.VER/ - GET THE VERSION TO SET UP IN LOCATION .JBVER(137)
;
; FORMAT: .VERSION 777BK(777777)-7 OR SOME SUBSET THEREOF
; THE RESULT IS "LOC"ED INTO WORD 137(ABSOLUTE) OF REL FILE CORE IMAGE
FP.VER: PUSHJ P,.PSH4T## ;SAVE TEMP ACS
SETZ T4, ;PLACE TO BUILD VERSION NUMBER
BYPASS ;GET FIRST NON-BLANK
TXO F,REGET
SKPNUM ;IS IT NUMBER?
JRST VER1 ;NO,THEN CANT BE MAJOR VERSION
PUSHJ P,OCTIN ;LOAD THE NUMBER
CAILE A,777 ;SMALL ENOUGH?
JRST AERROR ;NO,SO COMPLAIN
DPB A,[POINT 9,T4,11] ;ELSE STORE IT
VER1: SKPABC ;IS CHARACTER ALPHABETIC?
JRST VER2 ;NO,SO CANT BE MINOR VERSION
MOVEI A,-"A"+1(CC) ;CONVERT FIRST PART OF MINOR VERSION
DPB A,[POINT 6,T4,17] ;STORE IT AWAY
TXZ F,REGET ;INSURE ITS NEW CHARACTER
PUSHJ P,MIC ;GET IT
SKPABC ;MINOR VERSION CAN BE TWO LETTERS
JRST VER2 ;BUT THIS ONE ISN'T
IMULI A,^D26 ;RADIX 26 ARITHMETIC
ADDI A,-"A"+1(CC) ;ADD IN THE SECOND PART
CAILE A,77 ;ONLY SIX BITS WIDE
JRST AERROR ;ELSE REPORT THE ERROR
DPB A,[POINT 6,T4,17] ;STORED AWAY FOR NOW
BYPASS ;GET NEXT CHARACTER PRIMED
VER2: CAIE CC,LPAREN ;CHECK FOR (77777) ,EDIT NUMBER
JRST VER3 ;NOT SUPPLIED
TXZ F,REGET ;SUPPLIED, EAT THE LPAREN
PUSHJ P,OCTIN ;GET THE OCTAL NUMBER
CAIG A,777777 ;GREATER THAN HALFWORD
CAIE CC,RPAREN ;OR NOT DELIMITED PROPERLY
JRST AERROR ;IS AN ERROR
HRRI T4,0(A) ;MERGE INTO VERSION WORD
BYPASS ;GET NEXT PART
VER3: CAIE CC,"-" ;IS IT "WHO MODIFIED"?
JRST VER4 ;NO
PUSHJ P,OCTIN ;GET OCTAL PART
CAILE A,7 ;3 BITS WIDE
JRST AERROR
DPB A,[POINT 3,T4,2] ;STORE INTO OUR WORD
VER4: MOVE T1,[1,,2] ;CODE BLOCK, TWO WORDS LONG
MOVEM T1,VERBLK+0 ;GOES INTO TOP OF BLOCK
MOVX T1,<BYTE (2)0,0> ;NEITHER LOCATION OR DATA IS TO
MOVEM T1,VERBLK+1 ;BE RELOCATABLE
MOVEI T1,.JBVER## ;THIS IS WHERE TO
MOVEM T1,VERBLK+2 ;LOCATE THE DATA
MOVEM T4,VERBLK+3 ;AND FINALLY,THIS IS THE DATA
PUSHJ P,.POP4T## ;RESTORE THE ACS
JRST MECELL ;END OF IT
; /FP.INS/ - ROUTINE TO INSERT A NEW EDIT. THIS ROUTINE PROCESSES
; FIX-PSEUDO-OPS OF THE FORMAT:
; .INSERT location, POSITION:arg, <code to match>
;
; WHERE THE FIRST FIELD (REQUIRED) IS THE LOCATION TO PATCH, (IE
; THE LOCATION THAT GETS THE "JUMPA <LOCATION-OF-PATCH-CODE>"
; WHERE THE SECOND FIELD (REQUIRED) IS THE POSITION OF THE PATCH
; IN RELATION TO THE DISPLACED INSTRUCTION (THE INSTRUCTION
; OVERWRITTEN WITH THE "JUMPA <LOCATION-OF-PATCH-CODE>"
; IF "POSITION" IS:
; AFTER THEN DISPLACED INSTR IS FIRST INSTRUCTION OF PATCH
; BEFORE THEN DISPLACED INSTR IS LAST INSTRUCTION OF PATCH
; REPLACE THEN FOR EACH INSTRUCTION TYPED IN, ONE IS DELETED
; AND NEVER EXECUTED
; REPLACE:n THEN n INSTRUCTIONS ARE NOT EXECUTED , REGARDLESS
; OF HOW MANY INSTRUCTIONS ARE INSERTED.
; NOTE: THE POSITION ARGUMENT CAN BE UNIQUE AT ONE LETTER (A,B,R)
;
; WHERE THE THIRD FIELD (OPTIONAL) IS THE WORD OF CODE AT THE
; LOCATION OF THE PATCH. IF PRESENT, THE ANGLE BRACKETS ARE
; REQUIRED. IF THE CODE DOES NOT MATCH THE ACTUAL CODE AT THE
; LOCATION SPECIFIED IN FIELD 1, A FATAL ERROR MESSAGE IS GIVEN.
FP.INS: PUSHJ P,.PSH4T## ;SAVE ACS
TXNN F,IAE ;INSIDE EDIT?
JRST E$$EPM ;".EDIT FIX-PSEUDO-OP IS MISSING"
TXOE F,IAI ;INSIDE INSERT,WAS INSIDE?
$KILL(IIA,.INSERT pseudo-op illegal inside range of .INSERT,N$SIX)
TXNE F,FSTMOD ;SEEN .MODULE FOR THIS EDIT?
JRST MKMERR ;NO,SO COMPLAIN
PUSHJ P,EVALEX ;EVALUATE EXPRESSION FOR LOCATION
TXNE D,C.NULL ;DONT ALLOW NULL
$KILL(IUN,Illegal to have null address in .INSERT,N$EDIT)
JUMPN C,FERROR ;DONT ALLOW LIT,EXT OR UDF
TLNN A,-1 ;MAKE SURE ITS VALID 18 BIT ADDRESS
TLNE B,-1 ;AND LH NOT RELOCATED
$KILL(IAI,Illegal address in .INSERT,N$EDIT)
PUSHJ P,WRDSRC ;MAKE SURE ITS VALID AS AN ADDRESS
$KILL(IAL,.INSERT address is not in current module in edit,N$SIX)
MOVE T1,TRCPTR ;DO SOME HOUSEKEEPING
AOS TB$LEN(T1) ;INDICATE NEW PCO GROUP
MOVEI T2,PCO1SZ ;UPDATE SIZE OF BLOCK
ADDM T2,TB$HED(T1) ;FOR LINK ITEM TYPE HEADER
MOVE T2,[1,,PCO1SZ] ;MAKE A PCO TYPE 1 HEADER
MOVE T1,TRCVAP ;SET TO UPDATE VARIABLE AREA
CAILE T1,TRCLST-PCO1SZ+1 ;
JRST E$$ITS ;NOT ENUFF TRACE STOREAGE LEFT
MOVEM T2,TB$PCO(T1) ;STORE IT
HRRZM A,TB$DAT(T1) ;STORE THE ADDRESS OF THE PATCH
MOVE A,0(C) ;PICK UP ORIG INSTRUCTION
MOVEM A,SAVCOD ;STORE IT FOR LATER
PUSHJ P,GETREL ;GET RELOCATION BYTE FROM (C) AND (B)
MOVEM D,SAVREL ;STORE SAVED ORIG. RELOCATION
SKPCM ;SHOULD HAVE COMMA HERE
JRST AERROR ;NOT ENOUGH ARGUMENTS
TXZ F,REGET ;DONT REGET COMMA
BYPASS ;[21]SKIP ANY SPACES
TXO F,REGET ;[21]AND GET THE NEXT CHARACTER
PUSHJ P,SYMIN ;GET THE SYMBOL
SKIPN A ;FIND ANYTHING?
$KILL(BAM,<BEFORE, AFTER or REPLACE missing from .INSERT>,N$EDIT)
MOVE T2,A ;
MOVE T1,[IOWD 3,[SIXBIT/BEFORE/
SIXBIT/REPLAC/
SIXBIT/AFTER/]]
HRRZI A,2(T1) ;FOR LATER ADJUSTMENT
PUSHJ P,.LKNAM## ;LOOK IT UP
JRST [MOVE N,T2
$KILL(NRP,Not a recognized position switch:,N$SIX)]
TLZ T1,-1 ;GET RID OF AOBJN LEFT HALF
SUBI T1,(A) ;CONVERT TO -1,0,+1
SETZM CPINST ;NO INSTRUCTIONS INSERTED YET
MOVEM T1,BARFLG ;AND STORE IT
SETZM CPREPI ;DEFAULT NUMBER FOR REPLACE:N
JUMPN T1,INS4 ;IF NOT /REPLACE DONT LOOK FOR ARG
CAIE CC,":" ;ARG THERE?
JRST INS4 ;NO,LEAVE IT 0
BYPASS
TXO F,REGET
PUSHJ P,EVALEX ;GET NUMBER OF INSTRS TO SKIP ON RETURN FROM PATCH
JUMPN B,RERROR ;CAN'T BE RELOCATABLE
JUMPN C,FERROR ;OR FORWARD REFERENCE
JUMPL A,E$$RTL ;[26]DON'T ALLOW A NEGATIVE OFFSET
MOVEM A,CPREPI ;DEPOSIT IT
MOVE T1,TRCVAP ;GET PCO POINTER AGAIN
HRRZ T2,TB$DAT(T1) ;GET ADDRESS OF PATCH BREAK
SOS T2 ;[50] BACK OFF ONE
ADD A,T2 ;[26]GET LAST LOCATION USED
PUSHJ P,WRDSRC ;MAKE SURE THIS IS NOT A CROQUE
SKIPA N,CPREPI ;RETURN PC NOT IN BOUNDS
JRST INS4 ;ITS OK
$KILL(RTL,.INSERT'S REPLACE argument of,N$OCT,$MORE)
MOVEI T1,[ASCIZ " too large for module "]
PUSHJ P,.TSTRG##
MOVE T1,CURMOD
PUSHJ P,.TSIXN##
JRST SAYEDT
INS4: TXO F,REGET ;SKIP BLANKS
BYPASS ;
SKPNCM ;END WITH COMMA?
PUSHJ P,ORGCOD ;YES, SO EVALUATE THE COMPARE CODE
PUSHJ P,SETPT ;ELSE JUST SET UP FOR PATCHING
PUSHJ P,.POP4T##
JRST MECELL ;CHARACTER ENDS CELL
; /FP.ENI/ - PROCESSOR TO HANDLE .ENDI FIX-PSEUDO-OP
; THIS PSEUDO-OP IS USED TO INDICATE THE END OF AN INSERT. WE
; DO SOME BOOKEEPING, FINISH THE PATCH WITH TWO
; INSTRUCTIONS OF FORM:
; JUMPA 1,CPRET
; JUMPA 2,CPRET+1
;
; AFTER THESE TWO INSTRUCTIONS, ALL "PSEUDO-LITERALS" ARE
; GENERATED.
;
FP.ENI: PUSHJ P,.PSH4T## ;SAVE THE TEMPS
TXZN F,IAI ;OFF INSERT,WAS IT ON?
JRST [MOVE N,CUREDT
$KILL(IPM,.ENDI seen without .INSERT in edit,N$SIX)]
MOVE T1,TRCVAP ;GET VARIABLE AREA POINTER
SKIPL BARFLG ;WAS THIS A /BEFORE PATCH?
JRST ENI3 ;NO, MUST BE /AFTER OR /REPLACE
MOVE C,CPADDR ;GET ADDRESS INSTRUCTION GOES TO
HRLM C,TB$PAT(T1) ;PUT IT AWAY FOR NOW
MOVE C,SAVCOD ;GET DISPLACED INSTRUCTION
MOVE B,SAVREL ;GET RELOCATION FOR INSTRUCTION
PUSHJ P,NEWCOD ;GENERATE THE INSTRUCTION
JRST INSERR
ENI3: HRRZ A,TB$DAT(T1) ;MOVING ORIG INSTR [FROM]
HLRZ B,TB$PAT(T1) ;ORIG INSTR [TO]
PUSHJ P,GFIXUP ;DO THE FIXUPS IF ANY
SKIPN BARFLG ;IF NOT /REPLACE OR
SKIPN CPREPI ;OR NO ARG TO /REPLACE
JRST ENI4 ;SKIP RETURN FIXUP
ADD A,CPREPI ;UPDATE BY NUMBER THEY SAID TO SKIP ON RETURN
MOVEM A,CPRET ;THIS IS RETURN PC TO USE
ENI4: HRRZ T2,TB$DAT(T1) ;FETCH ADDRESS OF INSERT
CAMGE T2,CPRET ;RETURN IS TO GREATER ADDRESS ,RIGHT?
JRST ENI5 ;THATS RIGHT,SO ALL IS OK
SKIPE BARFLG ;IF NOT "REPLACE"
$STPCD(Patch return PC is incorrect)
AOS CPRET ;ITS REPLACE:1 WITH NULL (DELETE)
ENI5: MOVE T2,CPINST ;NUMBER OF INSTRUCTIONS INSERTED
HRLM T2,TB$DAT(T1) ;DEPOSIT INTO CURRENT TRACE AREA
ADDI T1,PCO1SZ ;UPDATE SIZE OF VARIABLE AREA POINTER
MOVEM T1,TRCVAP ;SO NEXT PCO DOES NOT OVERWRITE THIS ONE
MOVSI C,(JUMPA 1,) ;GENERATE RETURNS
HRR C,CPRET ;
MOVEI B,1 ;RIGHT RELOCATED
PUSHJ P,NEWCOD ;GENERATE NEW CODE
JRST INSERR ;NO MORE ROOM
ADD C,[Z 1,1] ;SECOND RETURN INSTRUCTION
MOVEI B,1 ;ALSO RELOCATABLE
PUSHJ P,NEWCOD ;INSERT IT TOO
JRST INSERR
PUSHJ P,PMLIT ;DO LITERAL FIXUPS
PUSHJ P,PMDEF ;DO ANY DEFINITIONS THAT OCCUR
PUSHJ P,.POP4T## ;RESTORE T1-4
JRST MECELL ;AND END IT
; /FP.REM/ - ROUTINE TO HANDLE .REMOVE FIX-PSEUDO-OP
;
; THIS FIX-PSEUDO-OP IS OF THE FORM :
; .REMOVE EDIT,EDIT , EDIT...
;
; THE PROCESSOR CHECKS FOR ERRORS, REPORTS CONFLICTS AND
; ALSO UPDATES POINTERS BESIDES REMOVING THE EDIT SPECIFIED.
;
FP.REM: PUSHJ P,.PSH4T## ;SAVE T1-T4
TXNN F,IAE ;INSIDE AN EDIT?
JRST E$$EPM ;NO,ITS AN ERROR
TXNE F,FSTMOD ;.MODULE SEEN?
JRST MKMERR ;NO,ITS AN ERROR
REM1: BYPASS ;SKIP BLANKS
TXO F,REGET
PUSHJ P,SYMIN ;GET EDIT NAME
JUMPE A,AERROR ;IF NULL NAME
CAMN A,CUREDT ;NOT TRYING TO DIDDLE THIS EDIT,ARE WE?
JRST ERIERR ;YES,COMPLAIN
MOVE T1,TRCVAP ;CURRENT VARIABLE POINTER
CAILE T1,TRCLST-<PCO2SZ-1> ;ENUFF ROOM LEFT?
JRST E$$ITS ;NO.
MOVE T2,[2,,PCO2SZ] ;HEADER FOR CHANGE ORDER
MOVEM T2,TB$PCO(T1) ;STORE IT
MOVEM A,TB$REN(T1) ;AND EDIT NAME REMOVED
ADDI T1,PCO2SZ ;UPDATE POINTER
MOVEM T1,TRCVAP ;TO REFLECT PCO
MOVE T1,TRCPTR ;UPDATE STATIC AREA SIZE
MOVEI T2,PCO2SZ ;BY RIGHT NUMBER OF WORDS
ADDM T2,TB$HED(T1) ;ALSO THE LINK ITEM HEADER
AOS TB$LEN(T1) ;AND COUNTER OF PCO GROUPS
PUSHJ P,FNDEDT ;FIND EDIT
JRST REM9 ;NOT THERE!
SKIPL TB$STA(B) ;IS IT ACTIVE?
JRST REM8 ;NO,SO CANT REMOVE IT
PUSH P,B ;SAVE POINTER TO EDIT
SETZ B, ;AND CHECK FOR CONFLICTS
PUSHJ P,CHKCNF ;REPORT ANY
POP P,T1 ;T1 IS NOW PTR TO REMOVED EDIT TRACE BLOCK
MOVE T2,WHO ;RESET WHO TOUCHED AND ACTIVE FLG
HRRZM T2,TB$STA(T1) ;XWD 0,,WHO
MOVEI T3,TB$VAR(T1) ;T3 GETS START OF VARIABLE AREA
HLRZ T4,TB$LEN(T1) ;T4 GETS NR. OF ASSOC EDIT COUPLETS
IMULI T4,AESIZ ;NUMBER OF WORDS PER A.E.
ADD T3,T4 ;POINT PAST THE A.E.S (IF ANY)
HRRZ T4,TB$LEN(T1) ;GET NR OF PCO GROUPS
MOVE T1,T3 ;GET ADDRESS OF FIRST PCO INTO T1
REM2: JUMPE T4,REM3 ;ANY PCOS LEFT TO DO?
HLRZ T3,TB$PCO(T1) ;YES,GET PCO TYPE
CAIE T3,1 ;IS IT INSERT PCO?
CAIN T3,4 ;OR ALTER PCO?
SKIPA
JRST REM2A ;NOT EITHER ONE
HLRZ B,TB$PAT(T1) ;GET ONE ADDRESS
HRRZ A,TB$DAT(T1) ;AND THE OTHER
PUSHJ P,SWPWRD ;GO CHANGE IT
REM2A: HRRZ T3,TB$PCO(T1) ;GET PAST THE PCO
ADDI T1,0(T3) ;TO NEXT ONE (IF ANY)
SOJG T4,REM2 ;AND UPDATE COUNT
REM3: TXO F,REGET ;START WITH SYMBOL DELIMITER
BYPASS ;
SKPNCM ;A COMMA?
JRST REM1 ;YES,GET NEXT EDIT NAME
PUSHJ P,.POP4T##
JRST MECELL ;
ERIERR: $KILL(ERI,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE or .REINSERT itself"]
PUSHJ P,.TSTRG##
JRST DONERR
REM8: MOVE N,CUREDT
$WARN(RIE,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE already inactive edit "]
REM8A: PUSHJ P,.TSTRG##
MOVE T1,A
PUSHJ P,.TSIXN##
X$$RIE:X$$RNE:
PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST REM3
REM9: MOVE N,CUREDT
$WARN(RNE,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE non-existent edit "]
JRST REM8A
; /FP.RNS/ - PROCESSOR FOR .REINSERT FIX-OP
;
; THIS FIX-PSEUDO-OP IS OF THE FORM :
; .REINSERT EDIT,EDIT...
;
; THE MODULES SPECIFIED ARE RE-ACTIVATED IF THEY HAVE BEEN
; REMOVED.
;
FP.RNS: PUSHJ P,.PSH4T## ;SAVE T1-4
TXNN F,IAE ;INSIDE EDIT?
JRST E$$EPM ;NO
TXNE F,FSTMOD ;[MODULE] SEEN?
JRST MKMERR ;NO,ITS AN ERROR
RNS1: BYPASS ;EAT BLANKS
TXO F,REGET
PUSHJ P,SYMIN ;GET AN EDIT NAME
JUMPE A,AERROR ;IF NULL,THIS IS ERROR
CAMN A,CUREDT ;CHECK FOR TRYING TO RE-INSERT ITSELF
JRST ERIERR ;THATS FATAL ERROR
MOVE T1,TRCVAP ;NOW ADD PCO
CAILE T1,TRCLST-<PCO3SZ-1> ;IF ROOM, ELSE
JRST E$$ITS ;ABORT ON INSUFFICIENT SPACE
MOVE T2,[3,,PCO3SZ] ;PCO HEADER
MOVEM T2,TB$PCO(T1) ;DEPOSIT IT
MOVEM A,TB$RIN(T1) ;ALSO THE EDIT NAME
ADDI T1,PCO3SZ ;UPDATE POINTER
MOVEM T1,TRCVAP ;AND STORE IT
MOVE T1,TRCPTR ;GET TRACE POINTER
MOVEI T2,PCO3SZ ;UPDATE SIZE
ADDM T2,TB$HED(T1) ;OF LINK BLOCK HEADER
AOS TB$LEN(T1) ;INCREMENT COUNT OF PCO'S
PUSHJ P,FNDEDT ;NOW FIND THE EDIT
JRST RNS9 ;NOT THERE. ITS AN ERROR
SKIPGE TB$STA(B) ;CHECK IF ITS NOT ACTIVE
JRST RNS8
PUSH P,B ;SAVE POINTER
MOVSI B,400000 ;RE-INSERTION FLAG ON
PUSHJ P,CHKCNF ;GENERATE WARNINGS FOR CONFLICTS
POP P,T1 ;POINT TO TRACE BLOCK
MOVE T2,WHO ;WHO IS AFFECTING STATUS
HRROM T2,TB$STA(T1) ;-1,,WHO
MOVEI T3,TB$VAR(T1) ;GET T3 LOADED WITH ADDRESS OF VARIABLE AREA
HLRZ T4,TB$LEN(T1) ;GET NUMBER OF ASSOC EDITS
IMULI T4,AESIZ ;NUMBER OF WORDS PER AE
ADD T3,T4 ;UPDATE IT
HRRZ T4,TB$LEN(T1) ;GET NR. OF PCO GROUPS
MOVE T1,T3 ;T1 HAS ADDR OF FIRST PCO
RNS2: JUMPE T4,RNS3 ;ANY PCOS LEFT TO DO?
HLRZ T3,TB$PCO(T1) ;YES,GET PCO TYPE
CAIE T3,1 ;IS IT INSERT PCO?
CAIN T3,4 ;OR ALTER PCO?
SKIPA
JRST RNS2A ;NOT EITHER ONE
HLRZ A,TB$PAT(T1) ;GET ONE ADDRESS
HRRZ B,TB$DAT(T1) ;AND THE OTHER
PUSHJ P,SWPWRD ;GO CHANGE IT
RNS2A: HRRZ T3,TB$PCO(T1) ;GET PAST THE PCO
ADDI T1,0(T3) ;TO NEXT ONE (IF ANY)
SOJG T4,RNS2 ;AND UPDATE COUNT
RNS3: TXO F,REGET ;CHECK DELIMITER
BYPASS
SKPNCM ;COMMA?
JRST RNS1 ;YES,GET NEXT NAME
PUSHJ P,.POP4T##
JRST MECELL ;ELSE BETTER END CELL
RNS8: MOVE N,CUREDT
$WARN(RIA,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REINSERT already active edit "]
RNS8A: PUSHJ P,.TSTRG##
MOVE T1,A
PUSHJ P,.TSIXN##
X$$RIA:X$$RIN:
PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST RNS3
RNS9: MOVE N,CUREDT
$WARN(RIN,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REINSERT non-existent edit "]
JRST RNS8A
; /FP.ALT/ - ROUTINE TO HANDLE INLINE ALTERATION OF A WORD IN THE FILE
; GENERATED BY PSEUDO-OPS OF THE FORM:
; .ALTER location, <NEW VALUE> , <ORIGINAL VALUE>
; THE FIRST FIELD (REQUIRED) IS THE LOCATION TO PATCH THE
; VALUE INTO. THE SECOND ARGUMENT IS EVALUATED AND PATCHED
; INTO THE LOCATION IDENTIFIED BY THE FIRST.
; THE THIRD ARGUMENT , WHICH MAY BE OMITTED, IS THE VALUE
; THAT IS CURRENTLY IN THE LOCATION SPECIFIED.
; THIS IS COMPARED ALONG THE SAME LINES AS THE THIRD ARGUMENT
; TO THE .INSERT PSEUDO-OP.
;
FP.ALT: PUSHJ P,.PSH4T## ;GET SOME ACS TO WORK WITH
TXNN F,IAE ;INSIDE AN EDIT?
JRST E$$EPM ;?EDIT PSEUDO OP IS MISSING?
TXNE F,FSTMOD ;MODULE SELECTED FOR THIS ALTERATION?
JRST MKMERR ;NO. DO NOT PROCEED
PUSHJ P,EVALEX ;EVALUATE FIRST ARGUMENT
TXNE D,C.NULL ;NO ARGUMENT THERE?
JRST AERROR ;NO. SAY ARGUMENT ERROR
JUMPN C,FERROR ;UNKNOWN LOCATION LOSES
TLNN A,-1 ;DONT ALLOW FUNNY VALUE
TLNE B,-1 ;IE LH AND LH(RELOC) ARE 0
$KILL(IAA,Illegal address in .ALTER,N$EDIT)
PUSHJ P,WRDSRC ;LOOK IT UP IN FILE
$KILL(AAL,.ALTER address is not in current module,N$EDIT)
MOVE T1,TRCPTR ;GET CURRENT TRACE BLOCK
AOS TB$LEN(T1) ;INDICATE NEW PCO GROUP
MOVEI T2,PCO4SZ ;UPDATE SIZE OF BLOCK
ADDM T2,TB$HED(T1) ;FOR LINK
MOVE T2,[4,,PCO4SZ] ;SET UP FOR CREATING PCO
MOVE T1,TRCVAP ;FETCH VARIABLE AREA POINTER
CAILE T1,TRCLST-PCO4SZ+1 ;DO WE STILL HAVE ROOM?
JRST E$$ITS ;NO, INSUFFICIENT ROOM
MOVEM T2,TB$PCO(T1) ;STORE HEADER AWAY
HRRZM A,TB$DAT(T1) ;ALSO STORE AWAY LOCATION
MOVE A,0(C) ;GET ACTUAL WORD
MOVEM A,SAVCOD ;STORE IT AWAY FOR NOW
PUSHJ P,GETREL ;GET THAT WORD'S RELOCATION
;NOTE C,B SET UP BY WRDSRC
MOVEM D,SAVREL ;SALT AWAY THE RELOCATION TOO
SKPCM ;DO WE HAVE A COMMA?
JRST AERROR ;NO,THIS IS AN ERROR
SETZM BARFLG ;SET UP FLAG FOR /AFTER
AOS BARFLG ;TYPE INSERT TO FAKE OUT SETPT
PUSHJ P,SETPT ;SET UP FOR PATCHING
PUSH P,CPADDR ;SAVE LOCATION OLD INST. PLACED IN
HRRZ A,TB$DAT(T1) ;LOAD CURRENT ADDRESS
MOVEM A,CPADDR ;FOR . (DOT) OPERATOR
TXZ F,REGET ;DONT REGET THE COMMA
BYPASS ;LOAD FIRST CHARACTER
CAIE CC,74 ;START WITH LEFT ANGLE BRACKET?
JRST QERROR ;NO
TXO F,REGET ;LET IT HAPPEN AGAIN
PUSHJ P,CELL ;EAT THE CELL
CAIE CC,76 ;END WITH RIGHT ANGLE BRACKET?
JRST QERROR ;NO
POP P,CPADDR ;RESTORE LAST GENNED ADDRESS
HRRZ T3,TB$DAT(T1) ;GET THE LOCATION TO PATCH INTO
TXO T3,IS.GEN ;FLAG THAT WORD EXISTS
HRRZ T2,C ;GET RH OF SYMFIX
JUMPE T2,ALT2 ;IF 0, DONT DO ANY FIXUP
IORB T3,1(T2) ;ELSE STORE ADDRESS
TXNE T3,IS.MWS ;ILLEGAL TO HAVE STRING OR BLOCK HERE
JRST [$KILL(ILS,Illegal use of long string or BLOCK in .ALTER,,$MORE)
JRST MCCOMM]
ALT2: HRRZ T3,TB$DAT(T1) ;GET THE LOCATION TO PATCH INTO
HLRZ T2,C ;GET LH OF SYMFIX
JUMPE T2,ALT3 ;IF 0, NO LH FIXUP
TXO T3,IS.LH!IS.GEN ;STORE THAT ITS A LH FIXUP
IORB T3,1(T2) ;REMEMBER IT IN IST
TXNE T3,IS.MWS ;CATCH ILLEGAL MULT-WORD STRING
JRST E$$ILS ;
ALT3: TDNE B,[^-<1,,1>] ;FLAG IMPROPER RELOCATION
JRST RERROR
HLRZ D,B ;CONVERT XWD RELOC TO BITS 35,35
LSH D,1 ;..
ORI D,(B) ;RESULT INTO D
PUSH P,A ;SAVE VALUE OF EXPRESSION
MOVEI A,0(T3) ;GET ADDRESS TO CHANGE
PUSH P,D ;SAVE RELOCATION AWAY
PUSHJ P,WRDSRC ;WRDSRC FOR RELOCATION
$STPCD(ALTER LOST ITS POINTERS)
POP P,D ;RESTORE RELOCATION
POP P,0(C) ;AND STORE NEW VALUE INTO WORD
PUSHJ P,CHGREL ;SET DOWN NEW RELOCATION
BYPASS ;EAT CHARACTERS
SKPNCM ;IS IT A COMMA?
PUSHJ P,ORGCOD ;YES,GO COMPARE CODE
HRRZ A,TB$DAT(T1) ;SET UP FOR (FROM) LOCATION
HLRZ B,TB$PAT(T1) ;SET UP THE (TO)
PUSHJ P,GFIXUP ;AND DO THE GLOBAL CHAIN FIXUPS
ADDI T1,PCO4SZ ;GET PCOSIZE
MOVEM T1,TRCVAP ;STORE IT AWAY
PUSHJ P,PMLIT ;GENERATE ANY LITERALS NEEDED
PUSHJ P,PMDEF ;ALSO ANY DEFINITIONS
PUSHJ P,PMEXT ;DO ANY EXTERNAL FIXUPS
PUSHJ P,PMLOC ;AND ANY LOCAL ONES
PUSHJ P,.POP4T## ;RESTORE THE TEMPS
JRST MECELL ;CURRENT CHARACTER ENDS CELL
; /FP.ENE/ - THIS ROUTINE PROCESSES THE ENE OF THE PATCH. ALL PATCHES
; START WITH THE FIX-PSEUDO-OP ".EDIT" AND END WITH THE
; FIX-PSEUDO-OP ".ENDE".
; FLAG "IAE" IS CLEARED TO INDICATE THAT
; WE ARE NOT IN AN EDIT. IT ALSO CHECKS FOR
; UNDEFINED SYMBOLS AND PRINTS AN ERROR MS. IF ANY EXIST.
FP.ENE: MOVE N,CUREDT ;IN CASE OF ERROR
TXZN F,IAE ;ARE WE IN AN EDIT
JRST E$$EPM ;NO,ERROR
TXZE F,IAI ;WERE NOT IN INSERT WERE WE?
$KILL(EEI,.ENDE seen before .ENDI in edit,N$SIX)
PUSHJ P,UDFCHK ;CHECK FOR UNDEFINED LABELS
JRST MECELL ;END OF CELL
IFE DEBUG,<XLIST> ;IF NOT DEBUGGING, CANT TEST
IFN DEBUG, <
; /FP.TST/ - INTERNAL CHECKING ROUTINE
; THIS ROUTINE IS AN INTERNAL TESTING PACKAGE FOR SOME OF THE BPT
; ROUTINES. TO USE IT, THE FOLLOWING SHOULD BE DONE.
; FOO.REL=MAKLIB.REL,TTY:/FIX ;COMMAND TO MAKLIB
; .EDIT XXXXX ;SOME SORT OF EDIT
; .MODULE MAKLIB ;USE CURRENT REL FILE
; .MKLTST ;START TESTS
;
; NOTE: DO NOT PATCH BEFORE OR AFTER TEST PACKAGE IS RUN BECAUSE
; ASSUMPTIONS ARE MADE AND TABLES CHANGED BY THIS ROUTINE.
;
;
DEFINE $TSTFAI, <JSP N,TELERR> ;REPORT TEST FAILURE
DEFINE $TSTDON,<
PUSHJ P,TELDON
>
DEFINE $TSTLBL($A)<TST.'$A:>
DEFINE $TSTGO($A),<
.ZZZ=.ZZZ+1
$TSTLBL(\.ZZZ)
MOVEI N,[ASCIZ "$A"]
MOVEM N,DEBROU
PUSHJ P,TELGO
>
.ZZZ==0
FP.TST: PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE A,[SIXBIT /MAKLIB/] ;MAKE SURE THEY SET US UP
CAME A,CURMOD ;BY READING IN MODULE MAKLIB
$KILL(TNI,<Tests not initialized, load MAKLIB>)
$TELL (ITC,MAKLIB internal tests commencing...)
SETZM DEBFAI ;0 FAILURES SO FAR
$TSTGO(CODE INSERT)
MOVE A,SEB+2 ;GET A PROGRAM BREAK
MOVEI B,PATMAX ;AND A LIMIT
TST4: PUSH P,A ;SAVE ACS
PUSH P,B
MOVEI B,1 ;RELOC
MOVEM A,CPADDR
SETOM CPSFLG
MOVE C,[JFCL 17,17] ;UNLIKELY CODE FOR LATER TEST
PUSHJ P,NEWCODE ;INSERT IT
$TSTFAI ;FAILURE
POP P,B ;RESTORE ACS
POP P,A ;
SOSE B ;DONE?
AOJA A,TST4 ;NO
AOS A
PUSHJ P,NEWCOD ;TEST THAT IT CATCHES OVERFLOW
CAIA
$TSTFAI
$TSTDON
$TSTGO(SYMBOL INSERT)
MOVE A,SEB+2 ;GET A STARTING ADDRESS
MOVEI B,CREMAX ;AND LIMIT
TST5: PUSH P,A ;SAVE ACS
PUSH P,B ;
MOVE R,[RADIX50 0,..S000] ;MAKE BASE OF SYMBOL
ADD R,A ;UPDATE IT
SUB R,SEB+2 ;TO BE ..S<ADR>
MOVEI B,1 ;RELOCATION IS 01(2) I.E. RH
PUSHJ P,NEWSYM ;DO IT
$TSTFAI ;REPORT FAILURE
POP P,B
POP P,A
SOSE B
AOJA A,TST5 ;IF MORE TO DO
AOJ A,
MOVEI B,1 ;RELOCATED IN RH ONLY
PUSHJ P,NEWSYM ;SEE IF WE OVERFLOWED
CAIA
$TSTFAI ;SHOULD CATCH IT
$TSTDON
$TSTGO(INTEGRATED LOOK/SEARCH/MAP)
MOVE R,[SIXBIT /..S000/] ;LOOKUP A NEW SYMBOL
PUSHJ P,SYMSRC ;LOOK IT UP
$TSTFAI ;REPORT FAILURE
CAIE B,10 ;SEE IF LOCAL SYMBOL
$TSTFAI
CAIE D,1 ;MAKE SURE RELOC IS RIGHT
$TSTFAI
CAME A,SEB+2 ;SEE IF THE SAME
$TSTFAI ;NOT RIGHT VALUE
PUSHJ P,WRDSRC ;NOW GET THE NEW WORD
$TSTFAI ;HAS TO BE THERE,WE PUT IT THERE
MOVE A,[JFCL 17,17] ;SEE IF THE RIGHT WORD IS THERE
CAME A,0(C) ;IN THE SPECIFIED PLACE
$TSTFAI ;IF WHAT IS THERE IS NOT WHAT WE PUT THERE
$TSTDON
$TSTGO(SYMBOL SEARCH)
MOVE D,.JBSYM## ;GET SYMBOL TABLE ADDRESS
TSTA: MOVE A,(D) ;FIND MAKLIB
CAMN A,[RADIX50 0,MAKLIB] ;SEARCH FOR HEADER
JRST TSTB ;IF FOUND
AOBJN D,TSTA
$WARN(NST,Cannot find MAKLIB symbol table,,$MORE)
X$$NST: JRST TST99 ;ABORT TESTS
TSTB: HLRE B,1(D) ;GET NEG LENGTH INTO B
ADD D,B ;D IS START ADDRESS OF MAKLIB S.T.
HRL D,B ;D IS AOBJN PTR NOW
ADD D,[2,,2] ;ADJUST POINTER
TST1: MOVE R,(D) ;LOAD A SYMBOL NAME
PUSH P,D ;SAVE D
TLZ R,740000 ;MASK OFF BITS
PUSHJ P,SYMSRA ;SEARCH FOR IT
$TSTFAI
POP P,D ;RESTORE D
ADD D,[2,,2] ;ADD FOR PAIR
JUMPL D,TST1
MOVE R,[RADIX50 0,$....$] ;MAKE SURE IT CAN FAIL
PUSHJ P,SYMSRA ;WHEN IT SHOULD
CAIA ;I.E. SYMBOL ISN'T THERE
$TSTFAI ;FAILURE MESSAGE
$TSTDON
$TSTGO(WORD SEARCH & MAP)
HRRZ A,.JBSA## ;GET STARTING ADDRESS
TST3A:
PUSHJ P,WRDSRC ;LOOK IT UP IN REL FILE
$TSTFAI
AOS A ;UPDATE A
CAIG A,DHISIZ ;TOO BIG?
JRST TST3A ;NO
MOVEI A,377777 ;MAKE SURE IT FAILS WHEN IT SHOULD
PUSHJ P,WRDSRC ;LOOK IT UP
CAIA
$TSTFAI
$TSTDON
$TSTGO(GLOBAL REFERENCE SEARCH)
MOVE R,[SIXBIT/TST6X/] ;MAP WORD IN REL FILE FIRST
PUSHJ P,SYMSRC ;LOOK IT UP
$TSTFAI
PUSHJ P,WRDSRC ;MAP IT
$TSTFAI
PUSH P,A ;SAVE A
JRST TST6B ;SKIP OVER TEST DATA
TST6X: 707070,,.TCRLF## ;XWD UNLIKELY CODE,REFERENCE
TST6B: SETZB R,T1
PUSHJ P,FGREF ;HUNT THRU CHAIN WITHOUT
;KNOWING SYMBOL NAME
$TSTFAI
CAME R,[RADIX50 0,.TCRLF] ;CORRECT SYMBOL FOUND?
$TSTFAI
HRRZ A,0(C) ;GET POINTER FROM RESULT
PUSHJ P,WRDSRC ;MAP IT INTO REL FILE
$TSTFAI
HLRZ A,0(C) ;
CAIE A,707070 ;FOUND RIGHT WORD?
$TSTFAI ;NO,CONTENTS OF WORD ARE WRONG
MOVE R,[SIXBIT/.TCRLF/] ;KNOW REPEAT,WITH SYMBOL KNOWN
MOVE A,0(P)
PUSHJ P,FGREF ;HUNT THRU CHAIN
;KNOWING SYMBOL NAME
$TSTFAI ;IF NOT FOUND
CAME R,[SIXBIT ".TCRLF"] ;CORRECT SYMBOL FOUND?
$TSTFAI ;FOUND REFERENCE,BUT NOT RIGHT ONE
HRRZ A,0(C) ;GET POINTER FROM RESULT
PUSHJ P,WRDSRC ;MAP IT INTO REL FILE
$TSTFAI ;MAPPING FAILED
HLRZ A,0(C) ;
CAIE A,707070 ;FOUND RIGHT WORD?
$TSTFAI ;MAPPED WRONG WORD
MOVE R,[SIXBIT/$....$/] ;LOOK FOR NON-EX SYMBOL
POP P,A ;WITH RIGHT ADDRESS
PUSHJ P,FGREF ;SHOULD FAIL
SKIPA
$TSTFAI ;FOUND NON-EX REFERENCE SYMBOL
MOVE R,[SIXBIT/.TCRLF/] ;LOOK FOR RIGHT SYMBOL
MOVEI A,2 ;WITH WRONG ADDRESS
PUSHJ P,FGREF ;SHOULD FAIL
SKIPA
$TSTFAI ;FOUND NON-EX REFERENCE CHAIN
$TSTDON
$TSTGO(IST MANIPULATION)
PUSHJ P,ISTINI ;START WITH FRESH IST
MOVEI A,ISTMAX ;NUMBER OF IST ENTRIES
MOVEI C,IST ;SHOULD BE FIRST ALLOCATED
TST7: PUSH P,A ;DONT ASSUME COUNT SAVED
MOVE T1,C ;SEE IF WE THINK ITS ALREADY VALID
PUSHJ P,ISTVAL ;WHICH IS AN ERROR
CAIA ;OK, CAUSE WE THINK ITS FREE
$TSTFAI ;REPORT FAILURE
PUSHJ P,ISTGET ;RETURN IN C THE ADDRESS OF IST PAIR
CAME T1,C ;DID WE GET THE ONE WE EXPECT?
$TSTFAI ;NO,NEXT IN ORDER NOT ALLOCATED!
PUSHJ P,ISTVAL ;NOW SEE IF ITS VALID.
$TSTFAI ;NO, AND IT SHOULD HAVE BEEN.
ADDI C,2 ;UPDATE ADDRESS
POP P,A ;RESTORE COUNT
SOJG A,TST7 ;IF MORE TO DO,TRY AGAIN
MOVE A,[^-<1B1>] ;FORCE DEALLOCATION OF 2ND PAIR ON
MOVEM A,ISTMAP ;BY ZEROING 2ND BIT IN MAP
MOVEI T1,IST+2 ;THIS WILL BE PAIR ALLOCATED
PUSHJ P,ISTVAL ;NOT VALID RIGHT NOW,RIGHT?
CAIA
$TSTFAI ;OH, OH, WELL REPORT ERROR
PUSHJ P,ISTSAV ;FORCE SAVE OF MAP
PUSHJ P,ISTGET ;NOW ALLOCATE
CAIE C,IST+2 ;GOT RIGHT PAIR?
$TSTFAI ;NO,SO SOMETHING IS WRONG
PUSHJ P,ISTVAL ;NOW IT IS VALID,OR SHOULD BE
$TSTFAI ;
PUSHJ P,ISTRST ;RESTORE MAP
PUSHJ P,ISTVAL ;NOW IT SHOULD NOT BE VALID
CAIA
$TSTFAI ;BECAUSE WE DID <SAVE><GET><RESTORE>
;SEQUENCE.
$TSTDON ;THATS OVER WITH
$TSTGO(OPCODE SEARCH)
MOVSI B,-OPNSIZ ;TEST OF TABLE FOR OPERATORS
MOVE C,[POINT 9,OPC] ;POINTER TO CODE TABLE
MOVE D,[POINT 18,OPH] ;POINTER TO AUX CODE TABLE
TST7A: MOVE R,OPN(B) ;LOAD AN OPERATOR NAME
PUSH P,B ;SAVE INDEX
PUSH P,C ;AND POINTER
PUSH P,D ;AND POINTER
PUSHJ P,OPSRC ;LOOK IT UP
$TSTFAI
POP P,D ;RESTORE D
POP P,C ;RESTORE C
POP P,B ;RESTORE B
ILDB T4,C ;GET OPERATOR
LSH T4,^D27 ;PUT IT INTO POSITION
TLC T4,700000 ;
TLCE T4,700000
JRST TST77 ;HANDLE HALFWORD STUFF DIFFERENTLY
ILDB T4,D ; GET IT
HRLZS T4
TST77: CAME T4,A ;
$TSTFAI ;FOUND,BUT INCORRECT CODE FOUND
AOBJN B,TST7A ;SEE IF MORE TO DO
SETZ R, ;MAKE SURE IT CAN FAIL
PUSHJ P,OPSRC ;WHEN IT SHOULD
CAIA
$TSTFAI ;FOUND NON-EXISTENT OP
$TSTDON
$TSTGO(MACRO CODE EVALUATION) ;CURSORY MACRO EVALUATION TEST
MOVEI B,400000 ;USE 400000 AS "."
MOVEM B,CPADDR
MOVSI B,-TST8CL ;NUMBER OF LINES TO DEBUG
TST8A: TXO F,DEBMOD!DEBIMC ;TRAP ANY ERRORS,USE INTERNAL CODE
MOVE C,[POINT 7,MACBUF] ;LOAD MACRO BUFFER
MOVEM C,MACPTR ;POINTER
SETZM MACCNT ;AND CLEAR CHARACTER COUNTER
HRLI D,(POINT 7,) ;SET UP INPUT POINTER
HRR D,TST8C(B)
TST8B: ILDB A,D ;GET A BYTE
AOS MACCNT ;UPDATE COUNTER
IDPB A,C ;STORE BYTE
CAIE A,.CHLFD ;END OF STRING?
JRST TST8B ;NO,GET NEXT BYTE
PUSHJ P,ISTINI ;NO IST YET
PUSH P,B ;SAVE INDEX ACROSS CALL
PUSHJ P,EVAL ;CALL EVALUATOR
POP P,B ;RESTORE POINTER
MOVE C,R%V ;CHECK VALUE
CAME C,TST8V(B) ;A MATCH?
$TSTFAI ;NO,REPORT FAILURE
MOVE C,R%R ;AND RELOCATION
CAME C,TST8R(B) ;CHECK MATCH HERE TOO
$TSTFAI ;IF FAILS, REPORT IT
SKIPE R%S ;MAKE SURE IST NOT INVOLVED
$TSTFAI ;ANOTHER FAILURE
AOBJN B,TST8A ;BACK FOR NEXT
TXZ F,DEBMOD!DEBIMC!REGET ;CLEAR FLAGS
JRST TST8X ;DONE WITH TEST
IFE PURESW, <$RELOC==140> ;RELOCATION IF 1 SEGMENT
IFN PURESW, <$RELOC==10> ;RELOCATION IF NORMAL 2 SEGMENT
; MACRO ENTRY HAS FORM, CODE TO READ,CODE TO MATCH, RELOC TO MATCH
DEFINE TST8M,<
IFE BIGLST, <XLIST>
X <12345>,<12345>,0 ;;SIMPLE NUMBER
X << >>,0,0 ;;NULL EXPRESSION
X < IFN F,<3>+IFE F,<4>>,4,0 ;;CONDITIONAL
X <MAKLIB>,<MAKLIB-$RELOC>,1 ;;SIMPLE SYMBOL
X <1+2*2!1-<1!2*2+1>>, <1+2*2!1-<1!2*2+1>>,0 ;;CHECK PRECEDENCE
X <1.1>,<1.1>,0 ;;CHECK FLOATING POINT
X <^L<1>>, <^L<1>>,0 ;;JFFO OP
X < ^-<1B1>>, <^-<1B1> >,0 ;;COMPLEMENT
X <<SIXBIT "123"+ '456'>>, <'123456'>,0 ;;SIXBIT
X <<ASCII "123Ab">>,<<ASCII "123Ab">>,0 ;;ASCII
X <<IOWD PD$LEN,1000>>, << <-PD$LEN>B17+777>>,0 ;;IOWD
X <<RADIX50 4,MAKLIB>>,<<RADIX50 4,MAKLIB>>,0 ;;RADIX50
X <<POINT 10,FP.TST,^O10>>,<<POINT 10,FP.TST-$RELOC,^O10>>,1 ;;POINT OP
X <<99.99E<1>>>, <<99.99E1>>,0 ;;EXPONENT
X <<1^!2>>, <3>,0 ;;XOR
X <<EXP <1+3>>>, 4,0
X <<BYTE (6)33(12)-1(9)5,5>>,<<337777005005>>,0
X <<DEC 10>>,12,0
X <<OCT 10>>,10,0
X <<CONSO>>,<<CONSO>>,0
X <<DATAI 1,>>,<<DATAI 1,>>,0
LIST
> ; END OF TST8M DEFINITION
DEFINE X ($A,$B,$C)< [ASCIZ \ $A
\]>
TST8C: TST8M
TST8CL==.-TST8C
DEFINE X($A,$B,$C) < EXP <$B> >
TST8V: TST8M
DEFINE X ($A,$B,$C) < EXP <$C> >
TST8R: TST8M
TST8X: $TSTDON
;HERE WHEN ALL TESTS DONE
TST99: MOVE N,DEBFAI ;GET NUMBER OF FAILURES
$TELL(ITF,Internal tests finished. Failures:,N$DEC)
PUSHJ P,.POP4T## ;RESTORE T1-T4
JRST MECELL ;MUST END CELL
TELERR: AOS DEBFAI ;UPDATE NUMBER OF FAILURES
MOVEI N,-1(N) ;GET PC OF ERROR CALL
PUSH P,N ;SAVE IT
MOVE N,DEBROU ;GET ERROR ROUTINE NAME
$WARN(TED,Test error detected in,N$STRG,$MORE)
MOVEI T1,[ASCIZ " routine. PC = "]
PUSHJ P,.TSTRG## ;
MOVE T1,0(P) ;GET ADDRESS
PUSHJ P,OUTHW ;AND PRINT IT
X$$TED: PUSHJ P,.TCRLF## ;END WARNING
JRST CPOPJ1 ;RETURN
TELGO:
X$$EIT: $TELL(STO,Starting test of,N$STRG,$MORE)
MOVEI T1,[ASCIZ " routine"]
PUSHJ P,.TSTRG##
X$$SIT:
MOVEI T1,[ASCIZ "]
"]
PUSHJ P,.TSTRG##
POPJ P, ;REPORT AND RETURN
TELDON: $TELL(EOT,End of test)
POPJ P,
> ; NFI DEBUG
IFE DEBUG,<LIST> ;RESUME LISTING
IFN DEBUG, < ;ONLY IF DEBUGGING
; /FP.DME/ - ROUTINE TO HELP DEBUG MACRO EVALUATOR
;
; TO USE, INCLUDE PSEUDO-OP ".DMON" IN FIX FILE.
; INSTEAD OF GENERATING CODE, CODE IS EVALUATED AND THE RESULT PRINTED
; OUT. ALSO, THE MACRO CODE ERRORS, USUALLY FATAL, ARE RETURNED WITHOUT
; ABORTING THE RUN.
; TO GET OUT OF THIS MODE, US THE PSEUDO-OP ".DMOFF" IN THE FIX FILE.
;
FP.DME: FP.DMN:
TXO F,DEBMOD ;PUT IT INTO DEBUG MODE
JRST MECELL ;END OF CELL
FP.DMF: TXZ F,DEBMOD ;NO MORE DEBUG MODE
JRST MECELL ;END OF CELL
; /.GODDT/ - THIS PSEUDO-OP CAUSES MAKLIB TO ENTER DDT
; IF IT IS LOADED. TO EXIT FROM DDT, USE THE
; COMMAND "CONTIN$X".
;
OPDEF CONTIN [JRST .GODD1]
.GODDT: SKIPN T,.JBDDT## ;SEE IF DDT LOADED
JRST MECELL ;NO,SO FORGET IT
PUSHJ P,.PSH4T## ;SAVE ACS
$TELL(DDT,Entering DDT)
JRST 0(T) ;GO TO DDT
.GODD1: PUSHJ P,.POP4T## ;RESTORE T1-4
JRST MECELL ;MUST BE STANDING ALONE
> ; NFI DEBUG
SUBTTL UTILITY ROUTINES FOR THE MACRO STATEMENT EVALUATOR
; /PSHOPR/ - ROUTINE TO PUSH ACS A,B,C,D ONTO THE OPERAND STACK
; /POPOPR/ - COMPLIMENTARY POP ROUTINE
; BOTH ROUTINES USE STACK "OPRSTK" AND TRAP PDL OVER AND
; UNDERFLOW.
;
PSHOPR: EXCH T,OPRPTR ;SAVE T,GET POINTER
CAILE T,OPRSIZ-3 ;4 LOCATIONS LEFT?
JRST ETCERR ;EXPRESSION TOO COMPLEX
MOVEM A,OPRSTK(T) ;STORE A-D
MOVEM B,OPRSTK+1(T) ;
MOVEM C,OPRSTK+2(T) ;
MOVEM D,OPRSTK+3(T)
ADDI T,4 ;UPDATE AND
EXCH T,OPRPTR ;STORE
POPJ P, ;RETURN
POPOPR: EXCH T,OPRPTR ;GET POINTER
SUBI T,4 ;GET BOTTOM OF POP
CAMGE T,OPRTOP ;UNDERFLOW INTO NEXT FRAME?
$STPCD(Expression stack underflowed)
MOVE A,OPRSTK(T) ;LOAD A-D
MOVE B,OPRSTK+1(T) ;FROM STOREAGE
MOVE C,OPRSTK+2(T) ;
MOVE D,OPRSTK+3(T)
EXCH T,OPRPTR ;STORE THE UPDATED POINTER
POPJ P, ;AND TAKE RETURN
; /PSHOPT/- ROUTINE TO PUSH OPERATOR INDEX IN AC T ONTO STACK
; /POPOPT/- COMPLIMENTARY POP ROUTINE
;
PSHOPT: EXCH D,OPTPTR ;GET POINTER
CAILE D,OPTSIZ ;ROOM LEFT?
JRST ETCERR ;EXPRESSION TO COMPLEX ERROR
MOVEM T,OPTSTK(D) ;
EXCH D,OPTPTR ;REPLACE POINTER
AOS OPTPTR ;UPDATE POINTER
POPJ P, ;RETURN
POPOPT: EXCH D,OPTPTR ;GET POINTER
SOS D ;
CAMGE D,OPTTOP ;UNDERFLOW?
$STPCD(Expression stack undeflowed)
MOVE T,OPTSTK(D) ;DO IT
EXCH D,OPTPTR ;RESTORE
POPJ P, ;RETURN
; /ASGEVL/ - ROUTINE TO EVALUATE OPS AFTER "SYMBOL="
;
; THIS ROUTINE STORES THE SYMBOL AND FLGS FOR THE CASE OF:
; SYMBOL='????' WHERE '????' IS ONE OF:
; =, =:, :, ! , :!
;
; INPUTS- AC A IS SIXBIT SYMBOL NAME
;
; OUTPUTS- ASGSYM IS SET UP AS FLAGS IN BITS 0-3+<RADIX50 SYMBOL>
;
ASGEVL: MOVE R,A ;GET SYMBOL NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX50
TXO R,R5.LCL ;START AS LOCAL SYMBOL
PUSHJ P,MIC ;GET CHARACTER AFTER FIRST =
CAIN CC,"=" ;IS IT ANOTHER = (NODDT)?
JRST [TXO R,R5.DDT ;YES,SUPRESS IT
PUSHJ P,MIC ;AND EAT THE CHARACTER
JRST .+1] ;
ASGEV1: CAIN CC,"!" ;IS IT "!" (ALSO SUPRESS)
JRST [TXOE R,R5.DDT ;YES,SUPRESS IT
JRST QERROR ;IF ALREADY ON
PUSHJ P,MIC ;EAT THE CHARACTER
JRST .+1] ;CONTINUE
CAIN CC,":" ;IS IT COLON?
JRST [TXOE R,R5.GLB ;YES,FLAG AS AVAILABLE
JRST QERROR ;TO OTHERS, IF NOT ALREADY
TXZ R,R5.LCL ;IF GLOBAL,ITS NOT LOCAL
PUSHJ P,MIC ;EAT IT
JRST ASGEV1] ;HANDLE CASE OF "=:!"
MOVEM R,ASGSYM ;STORE FLAGS+SYMBOL
TXO F,REGET ;REGET CHARACTER
POPJ P, ;RETURN TO CALLER
; /ASGMAK/ - ROUTINE TO MAKE THE ACTUAL ASSIGNMENT OF 'SYMBOL==EXPRESSION'
; THIS ROUTINE ASSIGNS THE VALUE OF THE CURRENT STATEMENT TO THE
; SYMBOL IN LOCATION "ASGSYM" . IN ADDITION, IT SETS THE NULL
; STATMENT FLAG IF THIS WAS A PRIMARY STATEMENT, SINCE IN THAT
; CASE WE DO NOT WISH TO GENERATE ANY CODE.
;
ASGMAK: MOVE R,ASGSYM ;GET SYMBOL NAME
TLZ R,740000 ;CLEAR NON-SYMBOL BITS
TXNE F,IAE ;INSIDE EDIT AND
TXNE F,FSTMOD ;IS THERE A MODULE SELECTED?
JRST ASGWNM ;YES,THATS A MISTAKE
PUSHJ P,SYMSRA ;LOOK IT UP IN RADIX50
CAIA ;DONT ALLOW RE-DEFINES
JRST MERRO1 ;
JUMPN %S,ASGERR ;OR FORWARD AND/OR EXT REFERENCES
MOVE R,ASGSYM ;RESET AS SYMBOL+FLAGS
TDNE %R,[^-<1,,1>] ;MAKE SURE RELOCATION IS OK
JRST RERROR ;ELSE FLAG ERROR
MOVE A,%V ;PICK UP THE VALUE
HRRZ B,%R ;AND RELOCATION
TLNE %R,1 ;CONVERT TO RIGHT FORMAT
TRO B,1B34 ;FOR NEWSYM
PUSHJ P,NEWSYM ;REGISTER THE SYMBOL
JRST STOERR ;IF NO ROOM, BOMB OUT
TXNN %F,S.NPS ;SKIP IF NOT PRIMARY
ASGMA1: SETOM NULFLG ;DISCARD CODE
PUSHJ P,PMLOC ;TRY TO REDUCE SIZE OF IST
POPJ P, ;RETURN
ASGERR: MOVE N,R ;GET SYMBOL
$KILL(ASG,FORWARD/EXTERNAL assignment to,N$50,$MORE)
JRST MCCOMM
ASGWNM: MOVE N,R
$WARN(AMI,Assignment to,N$50,$MORE)
MOVEI T1,[ASCIZ " with no module selected was ignored:
"]
PUSHJ P,.TSTRG##
PUSHJ P,TYPTB1
MOVEI T1,MACBUF
PUSHJ P,.TSTRG##
SKIPA
X$$AMI: PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST ASGMA1
; /FINLIN/ - ROUTINE TO FINISH UP THE LINE WHENEVER A COMMENT IS SEEN
; USED TO KEEP NSTLVL UP TO DATE AND TO GET TO $EOL
;
FINLIN: PUSHJ P,MIC ;GET A CHARACTER
CAIN CC,$EOL ;IS IT END OF LINE?
POPJ P, ;YES, RETURN
CAIE CC,RABRKT ;IS IT A RIGHT ANGLE BRACKET?
JRST FINLIN ;NO, TRY NEXT CHARACTER
SKIPE NSTLVL ;IF COUNT IS NON-ZERO,
SOS NSTLVL ;DECREMENT IT
JRST FINLIN ;AND TRY NEXT CHARACTER
; /MACSRC/ - ROUTINE TO SEARCH ALL THE BUILT IN CODES FOR MACRO-10
;
; INPUTS- AC R SHOULD CONTAIN A SIXBIT SYMBOL
;
; OUTPUTS- AC A WILL CONTAIN THE PROPERLY SET UP MACRO-10 INSTRUCTION
; AC B & AC C WILL CONTAIN 0
; AC D WILL CONTAIN THE APPROPRIATE FLAGS INDICATING WHAT
; TYPE OF CELL IS BEING RETURNED.
; SHOULD BE ONE OF: C.OP, C.POP
;
; RETURNS: CPOPJ=NO MATCH AT ALL CPOPJ1=MATCH FOUND SOMEPLACE
;
; ORDER OF SEARCH IS: MACHINE OPS,CALLIS,TTCALLS,MTAPES,PSEUDO-OPS
;
MACSRC: PUSHJ P,OPSRC ;FIRST LOOK AT MACHINE CODES
CAIA ;NOT THERE
JRST MACSR9 ;A MATCH!
MOVE A,[XWD -CALNTH,CALTBL] ;LOOK AT CALLI TABLE NOW
MACSR1: CAMN R,0(A) ;CHECK FOR MATCH
JRST [ SUBI A,CALLI0 ;ADJUST CODE
HRLI A,(CALLI) ;SET INSTR. PART
JRST MACSR9] ;END IT
AOBJN A,MACSR1 ;LOOP BACK FOR MORE
MOVSI A,-TTCLTH ;NOW TRY THE TTCALLS
MACSR2: CAMN R,TTCTBL(A) ;A MATCH?
JRST [ LSH A,5 ;YES,SET UP IN AC FIELD
ANDI A,(Z 17,) ;CLEAR OUT THE JUNK
HRLZI A,<(TTCALL)>(A) ;
JRST MACSR9 ] ;FINISH AS USUAL
AOBJN A,MACSR2 ;IF MORE TTCALLS LEFT
MOVSI A,-MTALTH ;NOW THE MTAPE CODES
MOVE B,[POINT 9,MTACOD] ;POINTER TO CODES USED
MACSR3: ILDB C,B ;GET BITS FOR THIS CODE
CAMN R,MTATBL(A) ;LOOK UP IN TABLE
JRST [ MOVSI A,(MTAPE) ;UUO CODE
HRRI A,(C) ;AND PARTICULAR FUNCTION CODE
JRST MACSR9] ;END IT
AOBJN A,MACSR3
MOVSI B,-POPLTH
;DEFINE BITS FOR PSEUDO-OP CHARACTERISTIC FLAGS
$1BIT==1B17 ;LEAVE RH FREE FOR ADDRESS
BIT($INP) ;THIS PSEUDO-OP NOT DEFINED OUTSIDE OF PRIMARY STATEMENT
BIT($III) ;THIS PSEUDO-OP ILLEGAL INSIDE OF .INSERT
BIT($COF) ;BEFORE RETURNING, CLEAR "IN-OP FIELD" FLAG
MACSR4: MOVE A,POPDO(B) ;LOAD FLAGS,,ADDRESS OF PROCESSOR
CAMN R,POPNAM(B) ;IS IT A MATCH?
JRST MCSR4B ;YES,RETURN
MCSR4A: AOBJN B,MACSR4 ;TEST FOR MORE TRIES LEFT
SETZB A,B ;CLEAR RESULTS
SETZB C,D ;SINCE GARBAGE IN ACS
POPJ P, ;NO MATCH RETURN
MCSR4B: TXNN A,$INP ;IS IGNORE IF NOT PRIMARY BIT ON?
JRST MCSR4C ;NO,SO FORGET THIS
TXNE %F,I.OP ;MUST BE IN OPCODE FIELD
TXNE %F,S.NPS ;OF PRIMARY STATEMENT
JRST MCSR4A ;ELSE IGNORE IT
MCSR4C: TXNE A,$III ;IS POP ILLEGAL IN RANGE OF INSERT?
TXNN F,IAI ;YES,ARE WE IN THAT?
CAIA
JRST IIIERR ;YES,TRAP IT
TXNE A,$COF ;WANT OPCODE FIELD CLEARED?
TXZ %F,I.OP ;YES, CLEAR IT
SKIPA D,[C.POP] ;A PSEUDO-OP WAS FOUND
MACSR9: MOVX D,C.OP ; SOME SORT OF OPCODE OR UUO FOUND
SETZB B,C ;CLEAR RELOCATION AND SYMBOL FIXUP
JRST CPOPJ1 ;TAKE SUCCESSFUL RETURN
IIIERR: MOVE N,R ;FOR ERROR MESSAGE
$KILL(III,Illegal pseudo-op in range of .INSERT: ,N$SIX,$MORE)
JRST MCCOMM
; /OPSRC/ - ROUTINE TO LOOKUP THE 9 BIT OPCODE FOR A SYMBOL, IF IT IS AN DEC-10 OPERATOR
;
; INPUTS- AC R CONTAINS SIXBIT SYMBOL
;
; OUTPUTS- IF SYMBOL IS -10 OPERATOR:
; AC A CONTAINS INSTRUCTION CODE IN BITS 0-8
; AC B & AC C CONTAIN 0
; AC D CONTAINS C.OP FLAG ON,ALL OTHERS OFF
;
; RETURNS: CPOPJ= SYMBOL NOT AN OPERATOR CPOPJ1=MATCH FOUND
;
OPSRC: SETZB B,D ;START LOCATION OF LIST
MOVEI C,OPNSIZ ;AND END OF LIST
OPSRC1: MOVE A,B ;GUESS IS (HIGH+LOW)/2
ADD A,C ;
ASH A,-1 ;
CAMN A,D ;SAME AS LAST GUESS?
POPJ P, ;YES,SO NO MATCH
MOVEM A,D ;STORE THIS GUESS INDEX
CAMLE R,OPN(A) ;GUESSED TOO LOW?
JRST [MOVE B,A ;YES,CORRECT LOW BOUND
JRST OPSRC1] ;
CAME R,OPN(A) ;A MATCH?
JRST [MOVE C,A ;NO,CORRECT UPPER BOUND
JRST OPSRC1] ;AND GO AGAIN
IDIVI A,4 ;FOUR CODES PER WORD OF OPC
MOVE A,OPC(A) ;GET CORRECT WORD
IMULI B,^D9 ;GET OPCODE IN BITS 26-35.
ROT A,^D9(B) ;FOR COMPARES ETC.
ANDI A,777 ;GET RID OF EXTRA STUFF
CAIGE A,700 ;"FAKE" OPCODE?
JRST OPSRC2 ;NO, SKIP HALFWORD STUFF
LSHC A,-1 ;CONVERT TO INDEX, HALF OFFSET
MOVE A,OPH-<700/2>(A) ;GET PROPER WORD
SKIPGE B ;WAS IT RIGHT HALF?
MOVSS A ;YES, REVERSE HALVES
HLRZ B,A ;GET THE OPCODE
CAIL B,700 ;IS THIS AN IO INSTRUCTION?
TXO %F,S.IOI ;YES,REMEMBER THAT
TRZA A,-1 ;CLEAR RIGHT HALF, SKIP SHIFT
OPSRC2: LSH A,^D27 ;PUT 9 BIT OPCODE INTO PLACE
SETZB B,C ;CLEAR RELOC AND FIXUP
JRST CPOPJ1 ;TAKE GOOD RETURN
; TABLE OF OPCODE NAMES AND THEIR ASSOCIATED VALUES
; EACH ENTRY IN THE LIST SHOULD CONTAIN THE NAME OF THE
; OPCODE AND ITS ASSOCIATED 9 BIT CODE
; THE ENTRIES MUST BE IN ALPHABETIC ORDER.
;
;
; OPCODES THAT ARE NOT IN BITS 0-8 INCLUSIVE (I.E. IO INSTRUCTIONS AND
; AND PSEUDO-INSTRUCTIONS SHOULD USE THE Y MACRO RATHER THAN
; THE X. THE FIRST ARGUMENT TO Y IS SAME AS X, BUT THE SECOND
; IS A VALUE TO BE PLACE IN LH OF INSTRUCTION. EXAMPLE:
; Y HALT,<JRST 4,>
;
;
; THE FOLLOWING HANDWAVING IS USED TO AVOID STORING ALL THE OPCODES
; AND THEIR NAMES AS A MACRO, WHICH WOULD SLOW UP COMPILATION CONSIDERABLY
; INSTEAD, ON PASS1 WE RESERVE SPACE FOR CODES AND NAMES, AND ON
; PASS2 WE ACTUALLY GENERATE CODE IN THE PROPER PLACES.
; THE THREE TABLES GENERATED ARE:
; OPN- TABLE OF SIXBIT NAMES OF OPCODES
; OPC- TABLE OF 9 BIT OPCODES
; OPH- TABLE OF AUX. HALFWORD VALUES
;
.XCREF ;TOO MESSY TO CREF
IF1,<
OPNSIZ==0
OPHSIZ==0
DEFINE X($A,$B)<
OPNSIZ==OPNSIZ+1>
DEFINE Y($A,$B)<
OPHSIZ==OPHSIZ+1
X($A,$B) >
>
IF2,< NLOC==OPN
CLOC==OPC
HLOC==OPH
..TMP1==-1
..TMP2==0
..TMP3==700
..TMP4==0
DEFINE X($A,$B)<
.ORG NLOC
SIXBIT/$A/
NLOC==NLOC+1
.ORG CLOC
$CODE($B)
CLOC==. >
DEFINE Y($A,$B)<
.ORG HLOC
IFE ..TMP3&1,<..TMP4==<$B>>
IFN ..TMP3&1,< EXP ..TMP4+<<$B>_-^D18>>
HLOC==.
X($A,..TMP3)
..TMP3==..TMP3+1
>
>
X ADD , 270
X ADDB , 273
X ADDI , 271
X ADDM , 272
X AND , 404
X ANDB , 407
X ANDCA , 410
X ANDCAB, 413
X ANDCAI, 411
X ANDCAM, 412
X ANDCB , 440
X ANDCBB, 443
X ANDCBI, 441
X ANDCBM, 442
X ANDCM , 420
X ANDCMB, 423
X ANDCMI, 421
X ANDCMM, 422
X ANDI , 405
X ANDM , 406
X AOBJN , 253
X AOBJP , 252
X AOJ , 340
X AOJA , 344
X AOJE , 342
X AOJG , 347
X AOJGE , 345
X AOJL , 341
X AOJLE , 343
X AOJN , 346
X AOS , 350
X AOSA , 354
X AOSE , 352
X AOSG , 357
X AOSGE , 355
X AOSL , 351
X AOSLE , 353
X AOSN , 356
X ASH , 240
X ASHC , 244
Y BLKI , BLKI
Y BLKO , BLKO
X BLT , 251
X CAI , 300
X CAIA , 304
X CAIE , 302
X CAIG , 307
X CAIGE , 305
X CAIL , 301
X CAILE , 303
X CAIN , 306
X CALL , 040
X CALLI , 047
X CAM , 310
X CAMA , 314
X CAME , 312
X CAMG , 317
X CAMGE , 315
X CAML , 311
X CAMLE , 313
X CAMN , 316
X CLEAR , 400
X CLEARB, 403
X CLEARI, 401
X CLEARM, 402
X CLOSE , 070
Y CONI , CONI
Y CONO , CONO
Y CONSO , CONSO
Y CONSZ , CONSZ
Y DATAI , DATAI
Y DATAO , DATAO
X DFAD , 110
X DFDV , 113
X DFMP , 112
X DFN , 131
X DFSB , 111
X DIV , 234
X DIVB , 237
X DIVI , 235
X DIVM , 236
X DMOVE , 120
X DMOVEM, 124
X DMOVN , 121
X DMOVNM, 125
X DPB , 137
X ENTER , 077
X EQV , 444
X EQVB , 447
X EQVI , 445
X EQVM , 446
X EXCH , 250
X FAD , 140
X FADB , 143
X FADL , 141
X FADM , 142
X FADR , 144
X FADRB , 147
X FADRI , 145
X FADRM , 146
X FDV , 170
X FDVB , 173
X FDVL , 171
X FDVM , 172
X FDVR , 174
X FDVRB , 177
X FDVRI , 175
X FDVRM , 176
X FIX , 122
X FIXR , 126
X FLTR , 127
X FMP , 160
X FMPB , 163
X FMPL , 161
X FMPM , 162
X FMPR , 164
X FMPRB , 167
X FMPRI , 165
X FMPRM , 166
X FSB , 150
X FSBB , 153
X FSBL , 151
X FSBM , 152
X FSBR , 154
X FSBRB , 157
X FSBRI , 155
X FSBRM , 156
X FSC , 132
X GETSTS, 062
Y HALT , HALT
X HLL , 500
X HLLE , 530
X HLLEI , 531
X HLLEM , 532
X HLLES , 533
X HLLI , 501
X HLLM , 502
X HLLO , 520
X HLLOI , 521
X HLLOM , 522
X HLLOS , 523
X HLLS , 503
X HLLZ , 510
X HLLZI , 511
X HLLZM , 512
X HLLZS , 513
X HLR , 544
X HLRE , 574
X HLREI , 575
X HLREM , 576
X HLRES , 577
X HLRI , 545
X HLRM , 546
X HLRO , 564
X HLROI , 565
X HLROM , 566
X HLROS , 567
X HLRS , 547
X HLRZ , 554
X HLRZI , 555
X HLRZM , 556
X HLRZS , 557
X HRL , 504
X HRLE , 534
X HRLEI , 535
X HRLEM , 536
X HRLES , 537
X HRLI , 505
X HRLM , 506
X HRLO , 524
X HRLOI , 525
X HRLOM , 526
X HRLOS , 527
X HRLS , 507
X HRLZ , 514
X HRLZI , 515
X HRLZM , 516
X HRLZS , 517
X HRR , 540
X HRRE , 570
X HRREI , 571
X HRREM , 572
X HRRES , 573
X HRRI , 541
X HRRM , 542
X HRRO , 560
X HRROI , 561
X HRROM , 562
X HRROS , 563
X HRRS , 543
X HRRZ , 550
X HRRZI , 551
X HRRZM , 552
X HRRZS , 553
X IBP , 133
X IDIV , 230
X IDIVB , 233
X IDIVI , 231
X IDIVM , 232
X IDPB , 136
X ILDB , 134
X IMUL , 220
X IMULB , 223
X IMULI , 221
X IMULM , 222
X IN , 056
X INBUF , 064
X INIT , 041
X INPUT , 066
X IOR , 434
X IORB , 437
X IORI , 435
X IORM , 436
Y JCRY , JCRY
Y JCRY0 , JCRY0
Y JCRY1 , JCRY1
Y JEN , JEN
X JFCL , 255
X JFFO , 243
Y JFOV , JFOV
Y JOV , JOV
X JRA , 267
X JRST , 254
Y JRSTF , JRSTF
X JSA , 266
X JSP , 265
X JSR , 264
X JSYS , 104
X JUMP , 320
X JUMPA , 324
X JUMPE , 322
X JUMPG , 327
X JUMPGE, 325
X JUMPL , 321
X JUMPLE, 323
X JUMPN , 326
X LDB , 135
X LOOKUP, 076
X LSH , 242
X LSHC , 246
X MAP , 257
X MOVE , 200
X MOVEI , 201
X MOVEM , 202
X MOVES , 203
X MOVM , 214
X MOVMI , 215
X MOVMM , 216
X MOVMS , 217
X MOVN , 210
X MOVNI , 211
X MOVNM , 212
X MOVNS , 213
X MOVS , 204
X MOVSI , 205
X MOVSM , 206
X MOVSS , 207
X MTAPE , 072
X MTOP. , 024
X MUL , 224
X MULB , 227
X MULI , 225
X MULM , 226
X OPEN , 050
X OR , 434
X ORB , 437
X ORCA , 454
X ORCAB , 457
X ORCAI , 455
X ORCAM , 456
X ORCB , 470
X ORCBB , 473
X ORCBI , 471
X ORCBM , 472
X ORCM , 464
X ORCMB , 467
X ORCMI , 465
X ORCMM , 466
X ORI , 435
X ORM , 436
X OUT , 057
X OUTBUF, 065
X OUTPUT, 067
X POP , 262
X POPJ , 263
Y PORTAL, PORTAL
X PUSH , 261
X PUSHJ , 260
X RELEAS, 071
X RENAME, 055
X ROT , 241
X ROTC , 245
Y RSW , RSW
X SETA , 424
X SETAB , 427
X SETAI , 425
X SETAM , 426
X SETCA , 450
X SETCAB, 453
X SETCAI, 451
X SETCAM, 452
X SETCM , 460
X SETCMB, 463
X SETCMI, 461
X SETCMM, 462
X SETM , 414
X SETMB , 417
X SETMI , 415
X SETMM , 416
X SETO , 474
X SETOB , 477
X SETOI , 475
X SETOM , 476
X SETSTS, 060
X SETZ , 400
X SETZB , 403
X SETZI , 401
X SETZM , 402
X SKIP , 330
X SKIPA , 334
X SKIPE , 332
X SKIPG , 337
X SKIPGE, 335
X SKIPL , 331
X SKIPLE, 333
X SKIPN , 336
X SOJ , 360
X SOJA , 364
X SOJE , 362
X SOJG , 367
X SOJGE , 365
X SOJL , 361
X SOJLE , 363
X SOJN , 366
X SOS , 370
X SOSA , 374
X SOSE , 372
X SOSG , 377
X SOSGE , 375
X SOSL , 371
X SOSLE , 373
X SOSN , 376
X STATO , 061
X STATUS, 062
X STATZ , 063
X SUB , 274
X SUBB , 277
X SUBI , 275
X SUBM , 276
X TDC , 650
X TDCA , 654
X TDCE , 652
X TDCN , 656
X TDN , 610
X TDNA , 614
X TDNE , 612
X TDNN , 616
X TDO , 670
X TDOA , 674
X TDOE , 672
X TDON , 676
X TDZ , 630
X TDZA , 634
X TDZE , 632
X TDZN , 636
X TLC , 641
X TLCA , 645
X TLCE , 643
X TLCN , 647
X TLN , 601
X TLNA , 605
X TLNE , 603
X TLNN , 607
X TLO , 661
X TLOA , 665
X TLOE , 663
X TLON , 667
X TLZ , 621
X TLZA , 625
X TLZE , 623
X TLZN , 627
X TRC , 640
X TRCA , 644
X TRCE , 642
X TRCN , 646
X TRN , 600
X TRNA , 604
X TRNE , 602
X TRNN , 606
X TRO , 660
X TROA , 664
X TROE , 662
X TRON , 666
X TRZ , 620
X TRZA , 624
X TRZE , 622
X TRZN , 626
X TSC , 651
X TSCA , 655
X TSCE , 653
X TSCN , 657
X TSN , 611
X TSNA , 615
X TSNE , 613
X TSNN , 617
X TSO , 671
X TSOA , 675
X TSOE , 673
X TSON , 677
X TSZ , 631
X TSZA , 635
X TSZE , 633
X TSZN , 637
X TTCALL, 051
X UFA , 130
X UGETF , 073
X UJEN , 100
X UMOVE , 100
X UMOVEI, 101
X UMOVEM, 102
X UMOVES, 103
X USETI , 074
X USETO , 075
X XCT , 256
X XOR , 430
X XORB , 433
X XORI , 431
X XORM , 432
X Z , 000
IF1,<
OPN: BLOCK OPNSIZ
OPC: BLOCK <OPNSIZ+3>/4
OPH: BLOCK <OPHSIZ+1>/2
>
IF2,<
.ORG CLOC
IFG ..TMP1,< EXP ..TMP2>
.ORG HLOC
IFN ..TMP3&1, <EXP ..TMP4>
>
DEFINE $CODE($B)<
IFE ^D35-..TMP1,<
EXP ..TMP2
..TMP1==-1
..TMP2==0 >
..TMP1==..TMP1+^D9
..TMP2==..TMP2!<$B>B<..TMP1>
> ;END OF $CODE DEFINITION
.CREF ;RESUME CREF OUTPUT
;TABLES FOR OTHER BUILT - IN MNEMONIC CODES, CALLI'S ETC.
;TABLE OF CALL IMMEDIATE MNEMONICS
CALTBL: ;USER DEFINED CALLI'S GO HERE
SIXBIT /LIGHTS/ ;-1
CALLI0: SIXBIT /RESET/ ; 0
SIXBIT /DDTIN/ ; 1
SIXBIT /SETDDT/ ; 2
SIXBIT /DDTOUT/ ; 3
SIXBIT /DEVCHR/ ; 4
SIXBIT /DDTGT/ ; 5
SIXBIT /GETCHR/ ; 6
SIXBIT /DDTRL/ ; 7
SIXBIT /WAIT/ ;10
SIXBIT /CORE/ ;11
SIXBIT /EXIT/ ;12
SIXBIT /UTPCLR/ ;13
SIXBIT /DATE/ ;14
SIXBIT /LOGIN/ ;15
SIXBIT /APRENB/ ;16
SIXBIT /LOGOUT/ ;17
SIXBIT /SWITCH/ ;20
SIXBIT /REASSI/ ;21
SIXBIT /TIMER/ ;22
SIXBIT /MSTIME/ ;23
SIXBIT /GETPPN/ ;24
SIXBIT /TRPSET/ ;25
SIXBIT /TRPJEN/ ;26
SIXBIT /RUNTIM/ ;27
SIXBIT /PJOB/ ;30
SIXBIT /SLEEP/ ;31
SIXBIT /SETPOV/ ;32
SIXBIT /PEEK/ ;33
SIXBIT /GETLIN/ ;34
SIXBIT /RUN/ ;35
SIXBIT /SETUWP/ ;36
SIXBIT /REMAP/ ;37
SIXBIT /GETSEG/ ;40
SIXBIT /GETTAB/ ;41
SIXBIT /SPY/ ;42
SIXBIT /SETNAM/ ;43
SIXBIT /TMPCOR/ ;44
SIXBIT /DSKCHR/ ;45
SIXBIT /SYSSTR/ ;46
SIXBIT /JOBSTR/ ;47
SIXBIT /STRUUO/ ;50
SIXBIT /SYSPHY/ ;51
SIXBIT /FRECHN/ ;52
SIXBIT /DEVTYP/ ;53
SIXBIT /DEVSTS/ ;54
SIXBIT /DEVPPN/ ;55
SIXBIT /SEEK/ ;56
SIXBIT /RTTRP/ ;57
SIXBIT /LOCK/ ;60
SIXBIT /JOBSTS/ ;61
SIXBIT /LOCATE/ ;62
SIXBIT /WHERE/ ;63
SIXBIT /DEVNAM/ ;64
SIXBIT /CTLJOB/ ;65
SIXBIT /GOBSTR/ ;66
0 ;67
0 ;70
SIXBIT /HPQ/ ;71
SIXBIT /HIBER/ ;72
SIXBIT /WAKE/ ;73
SIXBIT /CHGPPN/ ;74
SIXBIT /SETUUO/ ;75
SIXBIT /DEVGEN/ ;76
SIXBIT /OTHUSR/ ;77
SIXBIT /CHKACC/ ;100
SIXBIT /DEVSIZ/ ;101
SIXBIT /DAEMON/ ;102
SIXBIT /JOBPEK/ ;103
SIXBIT /ATTACH/ ;104
SIXBIT /DAEFIN/ ;105
SIXBIT /FRCUUO/ ;106
SIXBIT /DEVLNM/ ;107
SIXBIT /PATH./ ;110
SIXBIT /METER./ ;111
SIXBIT /MTCHR./ ;112
SIXBIT /JBSET./ ;113
SIXBIT /POKE./ ;114
SIXBIT /TRMNO./ ;115
SIXBIT /TRMOP./ ;116
SIXBIT /RESDV./ ;117
SIXBIT /UNLOK./ ;120
SIXBIT /DISK./ ;121
SIXBIT /DVRST./ ;122
SIXBIT /DVURS./ ;123
SIXBIT /XTTSK./ ;124
SIXBIT /CAL11./ ;125
SIXBIT /MTAID./ ;126
SIXBIT /IONDX./ ;127
SIXBIT /CNECT./ ;130
SIXBIT /MVHDR./ ;131
SIXBIT /ERLST./ ;132
SIXBIT /SENSE./ ;133
SIXBIT /CLRST./ ;134
SIXBIT /PIINI./ ;135
SIXBIT /PISYS./ ;136
SIXBIT /DEBRK./ ;137
SIXBIT /PISAV./ ;140
SIXBIT /PIRST./ ;141
SIXBIT /IPCFR./ ;142
SIXBIT /IPCFS./ ;143
SIXBIT /IPCFQ./ ;144
SIXBIT /PAGE./ ;145
SIXBIT /SUSET./ ;146
SIXBIT /COMPT./ ;147
SIXBIT /SCHED./ ;150
SIXBIT /ENQ./ ;151
SIXBIT /DEQ./ ;152
SIXBIT /ENQC./ ;153
SIXBIT /TAPOP./ ;154
SIXBIT /FILOP./ ;155
SIXBIT /CAL78./ ;156
SIXBIT /NODE./ ;157
SIXBIT /ERRPT./ ;160
SIXBIT /ALLOC./ ;161
SIXBIT /PERF./ ;162
SIXBIT /DIAG./ ;163
SIXBIT /DVPHY./ ;164
SIXBIT /GTNTN./ ;165
SIXBIT /GTXTN./ ;166
SIXBIT /ACCT./ ;167
SIXBIT /DTE./ ;170
SIXBIT /DEVOP./ ;171
CALNTH==.-CALTBL
;TABLE OF TTCALL MNEMONICS
TTCTBL: SIXBIT /INCHRW/ ; 0 INPUT A CHAR. AND WAIT
SIXBIT /OUTCHR/ ; 1 OUTPUT A CHAR.
SIXBIT /INCHRS/ ; 2 INPUT A CHAR. AND SKIP
SIXBIT /OUTSTR/ ; 3 OUTPUT A STRING
SIXBIT /INCHWL/ ; 4 INPUT CHAR., WAIT, LINE MODE
SIXBIT /INCHSL/ ; 5 INPUT CHAR., SKIP, LINE MODE
SIXBIT /GETLCH/ ; 6 GET LINE CHARACTERISTICS
SIXBIT /SETLCH/ ; 7 SET LINE CHARACTERISTICS
SIXBIT /RESCAN/ ;10 RESET INPUT STREAM TO COMMAND
SIXBIT /CLRBFI/ ;11 CLEAR TYPEIN BUFFER
SIXBIT /CLRBFO/ ;12 CLEAR TYPEOUT BUFFER
SIXBIT /SKPINC/ ;13 SKIPS IF A CHAR. CAN BE INPUT
SIXBIT /SKPINL/ ;14 SKIPS IF A LINE CAN BE INPUT
SIXBIT /IONEOU/ ;15 OUTPUT AS AN IMAGE CHAR.
TTCLTH==.-TTCTBL
;TABLE OF MTAPE MNEMONICS
MTATBL: SIXBIT /MTWAT./ ; 0
SIXBIT /MTREW./ ; 1
SIXBIT /MTEOF./ ; 3
SIXBIT /MTSKR./ ; 6
SIXBIT /MTBSR./ ; 7
SIXBIT /MTEOT./ ; 10
SIXBIT /MTUNL./ ; 11
SIXBIT /MTBLK./ ; 13
SIXBIT /MTSKF./ ; 16
SIXBIT /MTBSF./ ; 17
SIXBIT /MTDEC./ ;100
SIXBIT /MTIND./ ;101
MTALTH==.-MTATBL
MTACOD: BYTE (9) 0,1,3,6
BYTE (9) 7,10,11,13
BYTE (9) 16,17,100,101
; PSEUDO-OPERATOR TABLE FOR THE MACRO EVALUATOR.
; THIS TABLE CONTAINS THE NAMES,CHARACTERISTICS AND THE ADDRESS
; OF THE PROCESSOR FOR EACH OF THE MACRO PSEUDO-OPS. THESE PSEUDO
; OPS ARE HANDLED AT THE LEVEL OF PRIMARY CELL, WHEN MACSRC
; FINDS THAT THE SYMBOL IT IS SEARCHING ON
; IS IN THIS TABLE.
;
; THERE ARE CURRENTLY THREE CHARACTERISTICS FOR PSEUDO-OPS
;
; 1) $INP - DONT FIND THIS PSEUDO-OP IF NOT PRIMARY STATEMENT
; THIS MEANS PRETEND ITS NOT FOUND IF WE HAVE:
; ['PSEUDO-OP' ...]
; ('P.O.'...)
; <'P.O.'...>
;IN OTHER WORDS, ANY CASE BUT :
; LABEL: PSEUDO-OP ....
;OR PSEUDO-OP.....
; 2) $III - MEANS IF THIS PSEUDO-OP IS FOUND INSIDE THE RANGE
; OF '.INSERT' ....... '.ENDI' THEN ITS A FATAL ERROR.
; 3) $COF - BEFORE RETURNING FROM EXECUTING PSEUDO-OP, CLEAR
; THE BIT THAT SAYS WE ARE IN THE OP CODE FIELD OF THE
; CURRENT STATEMENT. THIS IS USED FOR PSEUDO-OPS
; THAT "EAT" THE REST OF THE LINE, BUT WISH TO
; USE EVALEX TO DO EXPRESSION EVALUATION. TURNING OFF
; THE I.OP FLAG MEANS THAT EXPRESSIONS INVOLVING LABELS THAT
; ARE THE SAME AS BUILT IN SYMBOLS, WILL GET EVALUATED RIGHT.
DEFINE POPMAK<
IFE BIGLST,<XLIST>
X (ASCII,EVP70)
X (ASCIZ,EVP70Z)
X (BLOCK,EVP85)
X (SIXBIT,EVP71)
X (IOWD,EVP72)
X (XWD,EVP73)
X (RADIX5,EVP74)
X (IFN,EVP83A)
X (IFE,EVP83B)
X (IFL,EVP83C)
X (IFG,EVP83D)
X (IFLE,EVP83E)
X (IFGE,EVP83F)
X (IFDEF,EVP83G)
X (IFNDEF,EVP83H)
X (IFEDIT,EVP83P)
X (IFNEDI,EVP83Q)
X (IFACTI,EVP83R)
X (IFNACT,EVP83S)
X (PURGE, EVP84,$INP)
X (SQUOZE,EVP74)
X (POINT,EVP75)
X (COMMEN,EVP76,$INP)
X (REMARK,EVP77,$INP)
X (TITLE, EVP77,$INP)
X (SUBTTL,EVP77,$INP)
X (EXP, EVP78)
X (DEC, EVP79)
X (OCT, EVP80)
X (BYTE, EVP81)
X (RADIX, EVP82,$INP)
X(.EDIT,FP.EDT,$III!$INP)
X (.MODUL, FP.MOD, $III!$INP)
X(.NAME,FP.NAM,$INP)
X(.DATE,FP.DAT,$INP)
X(.ASSOC,FP.ASC,$III!$INP)
X(.REMOV,FP.REM,$III!$INP)
X(.VERSI,FP.VER,$INP)
X (.REINS, FP.RNS,$III!$INP)
X (.INSER, FP.INS,$INP!$COF)
X (.ENDI, FP.ENI,$INP)
X (.ENDE, FP.ENE,$INP)
X (.ALTER, FP.ALT,$INP!$III!$COF)
IFN DEBUG,<
X (.MKLTS, FP.TST,$INP!$III) ;;RUN INTERNAL ROUTINE TEST PACKAGE
X (.DMON, FP.DMN, $INP) ;;ENTER DEBUG MODE FOR MACRO INTERPRETER
X (.DMOFF,FP.DMF, $INP) ;;LEAVE DEBUG MODE FOR MACRO INTERPRETER
X (.GODDT,.GODDT, $INP) ;;ENTER DDT, LEAVE VIA "CONTIN$X"
> ; NFI DEBUG
LIST
> ;END OF POPMAK DEFINTION
DEFINE X($A,$B,$C)< SIXBIT /$A/> ;;DEFINE THE NAME TABLE
POPNAM: POPMAK
POPLTH==.-POPNAM
DEFINE X($A,$B,$C)< EXP <$B+$C>> ;;DEFINE THE PROCESSOR ADDRESS LIST
POPDO: POPMAK
; /ORGCOD/ - ROUTINE TO PROCESS THE ORIGINAL CODE MATCH
; WHERE HERE WE COMPARE THE MACRO
; CODE GIVEN TO WHAT IS THERE AND
; FILTER OUT ERRORS.
; INPUTS- NONE
; OUTPUTS- NONE
;
;
ORGCOD: PUSHJ P,.PSH4T## ;SAVE T1-T4
PUSH P,CPADDR ;SAVE CURRENT PATCH ADDRESS
MOVE T1,TRCVAP ;GET CURRENT LOCATION
HRRZ T1,TB$DAT(T1) ;OF PATCH BREAK FOR EVALS TO USE
MOVEM T1,CPADDR ;CURRENT PATCH ADDRESS
PUSHJ P,ISTSAV ;SAVE STATE OF IST
BYPASS ;EAT TILL THE "L.BRACKET"
TXO F,REGET ;REGET FIRST CHARACTER AGAIN
CAIE CC,74 ;MAKE SURE THATS WHATS THERE
JRST ORG0 ;IF NOT,SKIP EVALUATION
PUSHJ P,CELL ;GET EXPRESSION "<.....>"
CAIE CC,76 ;INSURE PROPER CLOSE
JRST QERROR
PUSHJ P,MIC ;GET NEXT CHARACTER LOADED
PUSHJ P,COMCOD ;COMPARE CODE
ORG0: POP P,CPADDR ;RESTORE THE CURRENT PATCH ADDRESS
PUSHJ P,.POP4T## ;RESTORE THE ACS
PJRST ISTRST ;RESTORE STATE OF IST
;AND RETURN TO CALLER
; /SETPT/ - ROUTINE TO SET UP FOR PATCHING
; THIS ROUTINE SETS UP THE BOOKKEEPING NECESSARY
; TO DO PATCHING WHEN AN .INSERT OR OTHER CHANGE
; PSEUDO-OP IS DONE. THE MAIN THINGS SET UP
; ARE LOCATIONS OF THE CP????? (CURRENT PATCH)
; FLAVOR
; INPUTS - NONE, EXCEPT THE CURRENT TRACE BLOCK
; OUTPUTS - CPADDR, CPSFLG, AND PATCH LABEL
;
SETPT: PUSHJ P,.PSH4T## ;SAVE ACS ON ALT. ENTRY
MOVE T1,TRCVAP ;GET VARIABLE AREA POINTER
HRRZ T2,TB$DAT(T1) ;GET PATCH ADDRESS
SKIPN T3,HSILOC ;DOES PROGRAM HAVE HI-SEG?
JRST SETPT1 ;NO,THAT SORT OF DECIDES IT
HRRZ T4,2(T3) ;GET FIRST DATA WORD (RH)
CAMGE T2,T4 ;PATCH LOC .GE. HISEG ORIGIN?
JRST SETPT1 ;NO,PATCH TO LOW SEGMENT
SETZM CPSFLG ;SET FLAG FOR HI-SEG PATCH
MOVE T4,SEB+2 ;GET HI-SEG BREAK FROM END BLOCK
JRST SETPT2 ;AND BACK INTO COMMON CODE
SETPT1: SETOM CPSFLG ;PATCH TO LOW SEGMENT
MOVE T4,SEB+2 ;LOAD WITH FIRST DATA WORD
SKIPE HSILOC ;UNLESS HAS HI-SEGMENT WHICH
MOVE T4,SEB+3 ;LOWSEG BREAK IS IN SECOND DATA WORD
SETPT2: MOVEM T4,CPADDR ;STORE CURRENT PATCH ADDRESS
SKIPGE BARFLG ;WAS IT /AFTER OR /REPLACE?
JRST SETP2A ;NO,SO JUST GO ON
HRLM T4,TB$PAT(T1) ;STORE WHERE ORIGINAL WENT
MOVE C,SAVCOD ;ORIGINAL CODE
MOVE B,SAVREL ;GET ORIG. INST. RELOCATION
PUSHJ P,NEWCOD ;INSERT NEW CODE
JRST INSERR ;INSERT ERROR
MOVE T4,CPADDR ;GET UPDATED ADDRESS
SKIPE BARFLG ;IF /AFTER POINT TO ORIG
SOS T4 ;CODE SO WE EXECUTE IT
SETP2A: HRRM T4,TB$PAT(T1) ; FOR TRACE BLOCK .
MOVSI T3,(JUMPA 0,) ;BREAK EXISTING CODE FLOW
HRR T3,T4 ;TO POINT TO PATCH BLOCK
MOVE A,T2 ;GET IN-CORE ADDRESS OF WORD
PUSHJ P,WRDSRC ;TO BE CHANGED FOR PATCH LINK
$STPCD(.INSERT lost its pointers)
MOVEM T3,0(C) ;DONE.
MOVEI D,1 ;RESET RELOCATION TO BE
PUSHJ P,CHGREL ;01 (IE. RELOCATE RH)
SKIPE BARFLG ;EXCEPT FOR /REPLACE
AOS T2 ;SET RETURN PC TO JUMPA+1
MOVEM T2,CPRET ;FOR NOW
MOVSI R,'% ' ;START AC R ON ITS LABEL
MOVE T3,CUREDT ;CURENT EDIT NAME
TRNN T3,77 ;RIGHT JUSTIFY IT
JRST [ LSH T3,-6
JRST .-1 ] ;TO GET LEAST SIG. BITS
LSH T3,6 ;NOW MAKE ROOM FOR "<PART>"
TLZ T3,770000
AOS T2,CPPART ;GET PART ID
CAILE T2,^D26 ;CHECK FOR 26TH PART
JRST SETPT3 ;YES,SO FORGET THIS
IORI T3,'A'-1(T2) ;T3 NOW HAS ' EDIT<PART>'
IOR R,T3 ;R NOW HAS "%EDIT<PART>"
PUSHJ P,SYMSRC ;LOOK UP THE SYMBOL
CAIA ;NOT FOUND RETURN
JRST SETPT3 ;CONFLICTS, FORGET IT
HRRZ A,TB$PAT(T1) ;PATCH ADDRESS
PUSHJ P,RAD50 ;CONVERT SYMBOL TO RADIX50
MOVEI B,1 ;ITS A LABEL,SO RELOCATE RH
PUSHJ P,NEWSYM ;INSERT THE SYMBOL
JFCL ;IF FAILS,JUST FORGET IT
SETPT3: PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;RETURN
; /COMCOD/ - ROUTINE TO CHECK FOR MATCH BETWEEN CODES
;
; THE IDEA IS TO FIND OUT IF THERE IS MATCH BETWEEN THE CODE
; GIVEN BY THE PATCH FILE AND THE CODE IN REL FILE.
; THE INPUT IS FROM EVALS, SAVCOD AND THE IST.
; THIS CODE CATCHES MOST ERRORS, BUT PROBABLY NOT ALL OF THEM.
;
; INPUTS- AC A CONTAINS CODE RETURNED BY EVALS
; AC C CONTAINS THE IST POINTER FOR THE CODE FOURPLET
; CPADDR CONTAINS LOCATION OF INSERT
; SAVCOD CONTAINS THE ORIGINAL CODE AT THAT LOCATION
;
; OUTPUTS: NONE
; RETURNS: ALWAYS CPOPJ, OR TO FATAL ERROR HANDLER
;
COMCOD: CAMN A,SAVCOD ;TAKE CARE OF 90% OF CASES RIGHT AWAY
POPJ P, ;MATCHES RIGHT OFF
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVEM P,SAVEP ;SAVE PDL POINTER
JUMPE C,COMC99 ;IF NO IST POINTER,THERE IS NO HOPE
MOVE T1,SAVCOD ;LOAD T1 WITH ORIG
MOVE T2,A ;T2 WITH NEW CODE
MOVE T3,C ;T3 WITH FIXUP POINTER
MOVE T4,CPADDR ;T4 WITH LOCATION WE ARE LOOKING AT
PUSHJ P,COM1 ;CALL LOCAL ROUTINE
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;AND RETURN
;/COM1/ - RECURSIVE MATCH CHECKER
; THIS ROUTINE TRIES TO MATCH CODE, TRACING LITERAL AND EXTERNAL POINTERS
; INPUTS: T1-ORIGINAL CODE
; T2-NEW CODE THAT TRIES TO MATCH
; T3-FIXUP WORD ON T2
; T4 ADDRESS THAT CONTENTS OF T1 CAME FROM
;
COM1: SETZM COMDON ;START WITH LEFT HALF
HLRZ A,T1 ;LOAD A-D WITH T1-T4 LH
HLRZ B,T2
HLRZ C,T3
HLRZ D,T4
COM1A: CAMN A,B ;DOES CODE MATCH?
JRST COM2 ;YES,TRY OTHER HALF OR QUIT
JUMPE C,COMC99 ;IF NOT IST,QUIT
MOVE D,1(C) ;GET 2ND WORD OF IST PAIR
TXNN D,IS.MWS ;MULTI-WORD STRING WONT SAVE US
TXNE D,IS.UDF ;SHOULD NOT BE AN UNDEFINED SYMBOL
JRST COMC99 ;IF IT IS,THERE IS ERROR
TXNN D,IS.DER ;IS THIS AN INDICATOR OF EXTERNAL REQUEST?
JRST COM1B ;NO,TRY LITERAL
MOVE R,0(C) ;GET SYMBOL NAME FROM IST
MOVE A,T4 ;MUST POINT TO THIS ADDRESS
PUSHJ P,FGREF ;LOOK UP THE REFERENCE
JRST COMC99 ;CANT FIND ONE
JRST COM2 ;CONTINUE
COM1B: TXNN D,IS.LIT ;IS THIS A LITERAL?
$STPCD(INTERIM SYMBOL TABLE has illegal flags)
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE T4,A ;ADDRESS IS CONTENTS A
MOVE C,0(C) ;GET POINTER TO LIT TRIPLET
MOVE T2,0(C) ;NEW CODE IS THE LITERAL
MOVE T3,2(C) ;AND IT HAS ITS OWN FIXUP POINTER
PUSHJ P,WRDSRC ;MAP WORD THAT A POINTS TO
JRST COMC99 ;IF OUT OF BOUNDS,FORCE NOT MATCH
MOVE T1,0(C) ;PICK UP WORD AT THAT LOCATION
PUSH P,COMDON ;SAVE HALF WORD INDICATOR
PUSHJ P,COM1 ;AND EVALUATE NEXT LEVEL
POP P,COMDON ;RESTORE
PUSHJ P,.POP4T## ;ALL THAT WE DESTROYED
;FALL INTO COM2
COM2: SKIPE COMDON ;DOING RIGHT HALF ?
POPJ P, ;YES,DONE
SETOM COMDON ;FLAG AS DOING RIGHT HALF
HRRZ A,T1 ;GET RIGHT HALVES
HRRZ B,T2
HRRZ C,T3
JRST COM1A ;CONTINUE
COMC99: MOVE P,SAVEP ;GET POINTER
$KILL(CDM,Existing code does not match original code,,$MORE)
PUSHJ P,.POP4T## ;RESTORE THE ACS
JRST MCCOMM ;TYPE OUT CURRENT LINE
;/SWPWRD/ - ROUTINE TO TAKE TWO WORDS AND SWAP THEIR POSITIONS
; AROUND IN THE REL FILE. THIS INCLUDES CHANGEING
; CONTENTS,RELOCATION AND GLOBAL FIXUP CHAINS.
;
; INPUTS: A CONTAINS LOCATION OF 1 WORD
; B CONTAINS RELOCATABLE LOCATION OF 2ND WORD
; RETURN: ALWAYS CPOPJ
;LOCAL DEFINITIONS
DEFINE $WRD1,<-1(P)>
DEFINE $WRD2,<0(P)>
SWPWRD: PUSH P,A ;SAVE CALLED ARGUMENT
PUSH P,B ;AND OTHER LOCATION TOO.
PUSHJ P,WRDSRC ;LOOKUP FIRST WORD IN FILE
$STPCD(TRACE BLOCK fouled up)
PUSHJ P,GETREL ;GET ITS RELOCATION
MOVE B,0(C) ;AND ITS CONTENTS
MOVEM B,SAVCOD ;SAVE CODE
MOVEM D,SAVREL ;AND RELOCATION
MOVEI B,-1 ;TEMPORARILY RELOCATE GLOBALS
PUSHJ P,GFIXUP ;TO NON-EXISTENT ADDRESS
MOVE A,$WRD2 ;GET SECOND WORDS ADDRESS
PUSHJ P,WRDSRC ;MAP IT INTO FILE
$STPCD(TRACE BLOCK fouled up)
PUSHJ P,GETREL ;GET ITS RELOCATION
EXCH D,SAVREL ;EXCHANGE THE RELOCATION
PUSHJ P,CHGREL ;WITH THE OTHER
MOVE B,0(C) ;NOW GET THE CONTENTS
EXCH B,SAVCOD ;GET OTHER CONTENTS,STORE THESE
MOVEM B,0(C) ;STORE UPDATED CONTENTS
MOVE B,$WRD1 ;NOW GET FIRST ADDRESS AGAIN
MOVE A,$WRD2 ;AND SECOND
PUSHJ P,GFIXUP ;RELOCATE FROM 2ND TO FIRST
MOVE A,$WRD1 ;LOCATION OF FIRST WORD
PUSHJ P,WRDSRC ;MAP IT
$STPCD(ERROR IN SWPWRD ROUTINE)
MOVE D,SAVREL ;GET RELOCATION
PUSHJ P,CHGREL ;CHANGE WORD ONE'S RELOCATION
MOVE D,SAVCOD ;GET CODE CONTENTS
MOVEM D,0(C) ;STORE INTO THIS ADDRESS
MOVEI A,-1 ;FIXUP GLOBAL CHAINS
MOVE B,$WRD2 ;FROM -1 TO LOC OF WORD2
PUSHJ P,GFIXUP ;FIXUP THE GLOBAL CHAINS
POP P,B ;RESTORE ARG2
POP P,A ;RESTORE ARG1
POPJ P, ;RETURN
IFN DEBUG,<
; /LSTCOD/ - THIS ROUTINE LISTS THE RESULTS OBTAINED IN CALL TO EVAL
; THE VALUES OF R%R,R%V AND SUCH ARE USED HERE TO PRINT OUT
; THE NUMERIC RESULT OF THE CALL TO EVAL
;
LSTCOD: PUSHJ P,.PSH4T## ;SAVE T1-T4
TXO F,FOTTY ;OUTPUT IS TO TTY
LDB T1,[POINT 9,R%V,8] ;GET INST
CAIN T1,777 ;IF 777,PROBABLY NEG NUMBER
JRST MAC0
HLRZ T2,R%R ;IF LEFT RELOC THEN NOT INSTR
JUMPN T2,MAC0
JUMPE T1,MAC0 ;IF NO INSTR., USE HALFWORD ONLY
PUSHJ P,.TOCTW## ;OUTPUT IN INSTRUCTION FORMAT
PUSHJ P,.TSPAC## ;
LDB T1,[POINT 4,R%V,12] ;AC FIELD
PUSHJ P,FILLO ;2 DIGIT FILLED OCTAL
LDB T1,[POINT 1,R%V,13] ;INDIRECT BIT
PUSHJ P,.TOCTW##
PUSHJ P,.TSPAC##
LDB T1,[POINT 4,R%V,17] ;GET INDEX REGISTER
PUSHJ P,FILLO ;2 DIGIT ,0 FILLED OCTAL
HRRZ T1,R%V ;FINALLY THE VALUE
PUSHJ P,OUTHW ;OF THE ADDRESS FIELD
HRRZ T2,R%R ;SEE IF RIGHT RELOC
MOVEI T1,"'" ;IF RELOCATED , PRINT "'"
SKIPE T2
PUSHJ P,.TCHAR##
PUSHJ P,TYPTB1 ;TAB OVER
MAC0: HLRZ T1,R%V ;HALFWORD FORMAT
PUSHJ P,OUTHW ;
HLRZ T2,R%R ;
MOVEI T1,[ASCIZ ",,"] ;PRETEND ITS NOT RELOCTATED
SKIPE T2 ;RELOCATION FLAG
MOVEI T1,[ASCIZ "',,"] ;IF LEFT HALF RELOCATED
PUSHJ P,.TSTRG## ;INDICATE SO
HRRZ T1,R%V
PUSHJ P,OUTHW ;SAME FOR RIGHT HALF
HRRZ T2,R%R
MOVEI T1,"'" ;SINGLE QUOTE IS RELOCATED
SKIPE T2
PUSHJ P,.TCHAR ;RELOCATION FLAG
PUSHJ P,.TCRLF## ;END LINE NOW
PUSHJ P,.POP4T## ;RESTORE ACS
TXZ F,FOTTY ;
POPJ P, ;AND RETURN
FILLO: CAIL T1,10 ;2 DIGITS ALREADY?
JRST FILLO1 ;YES,SKIP "0" FILL
PUSH P,T1 ;SAVE VALUE
MOVEI T1,"0" ;
PUSHJ P,.TCHAR## ;OUTPUT ASCII 0
POP P,T1 ;RESTORE VALUE
FILLO1: PUSHJ P,.TOCTW## ;OUTPUT OCTAL AC VALUE
PJRST .TSPAC## ;FOLLOWED BY SPACE
> ; NFI DEBUG
; /UDFCHK/ - THIS ROUTINE CHECKS FOR ENTRIES STILL IN IST AFTER ALL DEFINTION DONE
; THIS ROUTINE EXAMINES IST AND COMPLAINS ABOUT ANY ENTRIES
; REMAINING IN IT. THIS ASSUMES THAT ALL EXTERNAL AND LITERAL
; GENERATIONS HAVE BEEN DONE ALREADY.
; THE CALLS TO UDFCHK ARE MADE FROM FIX-PSEUDO-OPS ".ENDE" AND ".MODULE"
; TO INSURE PROPER DEFINITIONS HAVE BEEN MADE FOR ALL SYMBOLS.
; INPUTS- ONLY THE IST. REMEMBER TO DO ALL DEFINITIONS FIRST
; OUTPUTS- FATAL ERROR MESSAGE
; RETURN- POPJ
;
UDFCHK: MOVE T1,[POINT 1,ISTMAP] ;ZERO UNUSED ENTRIES
MOVEI T2,IST ;SO DONT GET CONFUSED
SETZM T ;CLEAR T
UDF0: ILDB T3,T1 ;GET BIT OF MAP
JUMPN T3,UDF00 ;IN USE
SETZM 0(T2) ;
JRST UDF01 ;NOT IN USE, SO SKIP CHECKS
UDF00: MOVEI T,2(T2) ;UPDATE POINTER TO LAST IN-USE
MOVE T4,1(T2) ;GET FLAG WORD
TXNE T4,IS.LIT!IS.MWS!IS.DER!IS.DEF ;MAKE SURE ITS USER NOT PROGRAM ERROR
$STPCD(A necessary forward fixup was not done)
UDF01: ADDI T2,2 ;TWO WORDS PER ENTRY
CAIG T2,ISTLST ;OVER THE END?
JRST UDF0 ;NO
JUMPE T,CPOPJ ;IF NO SLOTS IN USE,JUST RETURN
MOVE N,CURMOD ;GET MODULE
$KILL(UDF,Module,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ in edit /]
PUSHJ P,.TSTRG## ;GIVE MOD AND EDIT
MOVE T1,CUREDT ;
PUSHJ P,.TSIXN##
MOVEI T1,[ASCIZ/ contains undefined symbol(s):
/]
PUSHJ P,.TSTRG## ;OUTPUT IT
UDF1: CAIG T,IST ;AT FRONT OF LIST?
JRST DONERR ;YES,SO CLOSE UP
SUBI T,2 ;GET TO FRONT OF PAIR
SKIPN T1,0(T) ;LOAD LABEL NAME
JRST UDF1 ;IGNORE NULL LABELS
PUSHJ P,TYPTB1 ;OUTPUT TAB
PUSHJ P,.TSIXN## ;AND LABEL NAME
PUSHJ P,.TCRLF##
MOVE B,T ;DONT PRINT DUPLICATE LABELS
UDF2: CAIG B,IST ;WAS THIS LAST ONE?
JRST UDF1 ;YES,BACK TO MAIN LOOP
SUBI B,2 ;KEEP BACKTRACKING
MOVE C,0(B) ;GET LABEL NAME
CAMN C,0(T) ;IS THIS DUPLICATE?
SETZM 0(B) ;YES,SO ZERO IT
JRST UDF2 ;AND LOOP BACK
SUBTTL ERROR MESSAGES FOR THE MACRO PROCESSOR
MERROR: PUSHJ P,RAD50 ;CONVERT SIXBIT TO RAD50
MERRO1: ;HERE IF ALREADY RAD50
MOVE N,R ;SYMBOL FOR MUL DEF
$KILL(MCM,Attempt to redefine value of symbol,N$50,$MORE)
JRST MCCOMM
WERROR: $KILL(MCW,<BYTE,EXP,DEC,or OCT more than one word>,,$MORE)
JRST MCCOMM
AERROR: $KILL(MCA,Pseudo-operator argument error,,$MORE)
JRST MCCOMM
QERROR: $KILL(MCQ,MACRO code is questionable,,$MORE)
JRST MCCOMM
NERROR: $KILL(MCN,MACRO code numeric error,,$MORE)
JRST MCCOMM
ETCERR: SKIPL P ;IF MASTER STACK OVERFLOWED THEN
MOVE P,EVLPP ;WE NEED EMERGENCY FIXUP
$KILL(ETC,MACRO code expression too complex,,$MORE)
JRST MCCOMM
FERROR: $KILL(MCF,Illegal forward or external reference,,$MORE)
JRST MCCOMM
UERROR: MOVE N,R ;LOAD SYMBOL IN QUESTION
$KILL(MCU,Undefined symbol:,N$SIX,$MORE)
JRST MCCOMM
RERROR: $KILL(MCR,MACRO code relocation error,,$MORE)
MCCOMM: MOVE P,EVLPP ;RESTORE POINTER
MOVEI T1,[ASCIZ " at "] ;GIVE LABEL+OFFSET
PUSHJ P,.TSTRG## ;OUTPUT IT
SKIPN T1,LLABEL ;DO WE HAVE A LABEL?
JRST MCCOM1 ;NO,CANT GIVE LABEL
PUSHJ P,.TSIXN## ;
MOVEI T1,"+" ;PLUS OFFSET
PUSHJ P,.TCHAR## ;
JRST MCCOM2 ;AND CONTINUE
MCCOM1: MOVEI T1,[ASCIZ "line "]
PUSHJ P,.TSTRG## ;IF NO LABEL, GIVE JUST LINE NUMBER
MCCOM2: MOVE T1,LLOFF ;IN ANY CASE, GIVE OFFSET
PUSHJ P,.TDECW ;IN DECIMAL
SKIPN N,CUREDT ;ARE WE INSIDE AN EDIT NOW?
JRST MCCOM3 ;NO,JUST END MESSAGE
MOVEI T1,[ASCIZ " (Edit "]
PUSHJ P,.TSTRG## ;OUTPUT EDIT NAME
MOVE T1,N ;EDIT NAME
PUSHJ P,.TSIXN## ;ITS IN SIXBIT
MOVEI T1,")" ;CLOSE IT OFF
PUSHJ P,.TCHAR## ;WITH RIGHT PAREN.
MCCOM3: PUSHJ P,.TCRLF##
PUSHJ P,TYPTB1 ;OUTPUT <CR><LF><TAB>
MOVEI T1,MACBUF ;OUTPUT CURRENT MACRO LINE
PUSHJ P,.TSTRG## ;AS AN ASCIZ STRING
X$$MCM: X$$MCQ: X$$MCN: X$$ETC: X$$MCF: X$$MCR: X$$MCA: X$$III:
X$$MCW: X$$CDM: X$$ASG: X$$MCU:
TXZ F,REGET!FOTTY ;CLEAR SOME FLAGS
IFN DEBUG,<
TXNE F,DEBMOD ;IN DEBUG MODE?
POPJ P, ;YES, GO BACK
>; NFI DEBUG
JRST DONERR ;END AS USUAL
SUBTTL END OF LONG,LONG CONDITIONAL UNDER IFN FTBPT
> ; NFI FTBPT
SUBTTL RADIX50 CONVERSION ROUTINE
RAD50: PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE T3,[POINT 6,R] ;SET UP SIXBIT POINTER TO R
MOVEI T2,6 ;SET COUNTER TO SIX
MOVEI T4,0
JUMPE R,RAD504 ;NULL SYMBOL?
RAD501: TRNE R,77 ;RIGHT-JUSTIFIED?
JRST RAD502 ;YES-CONVERT TO RADIX50
ROT R,-6 ;NO-SHIFT IT ONE PLACE RIGHT
JRST RAD501 ;CHECK AGAIN
RAD502: ILDB T1,T3 ;PICK UP NEXT CHARACTER IN R
JUMPE T1,RAD503 ;A BLANK IS A BLANK IN ANY RADIX
IMULI T4,50 ;CONVERT TO RADIX50
CAIE T1,'%' ;IS IT A '%'?
CAIN T1,'$' ;IS IT A $ ?
ADDI T1,70 ;YES-COMPENSATE FOR SUBTRACTION
CAIN T1,'.' ;IS IT A '.' ?
ADDI T1,55 ;YES-COMPENSATE
CAILE T1,31 ;TRANSLATE RADIX50 CODE
SUBI T1,7 ;LETTER-SUBTRACT 26
SUBI T1,17 ;NUMBER-SUBTRACT 17
ADD T4,T1 ;COMBINE WITH PARTIAL WORD
RAD503: SOJG T2,RAD502 ;LOOP FOR SIX CHARACTERS
RAD504: MOVE R,T4 ;PUT SYMBOL BACK IN R
PUSHJ P,.POP4T## ;RESTORE OUR TEMPS
POPJ P, ;GIVE IT TO WHOEVER WANTED IT
SUBTTL ERROR ROUTINES
; /E$TEL/ - COMMENT MESSAGE
; /E$WRN/ - WARNING MESSAGE
; /E$KIL/ - FATAL MESSAGE AND RESTART
; CALLED VIA MACROS $KILL,$WARN,$TELL (SEE FRONT OF LISTING)
;
; INPUT - T1 POINTS TO INSTRUCTION OF JUMP [LITERAL]
; WHERE LITERAL IS TWO WORDS LONG OF FORMAT:
; XWD CODE OF ERROR (SIXBIT),ADDRESS OF STRING FOR ERROR
; XWD TYPEOUT ROUTINE OR 0 ,SKIP CONTINUATION (OR 0)
;
; RETURNS- NORMALLY AT CALL + 1
; UNLESS THIS IS A FATAL ERROR MESSAGE, IN WHICH CASE WE RESTART.
;
; IF THE CONTINUATION FIELD IS NON-ZERO AND WE HAVE
; MESSAGE BITS SET FOR SHORT MESSAGE, WE JRST TO THE
; ADDRESS SPECIFIED IN RH OF LITERAL+1
; NOTE: FOR DEBUGGING, LOCATION ERRPC CONTAINS XWD FLAGS,PC OF ERROR CALL
FTEL==1B19 ;TEMPORARY BITS STORED IN ERRPC(LH)
FWRN==1B20
FKIL==1B21
E$TEL: MOVSI T2,"["+FTEL ;COMMENT MESSAGE
JRST E$COM ;CONTINUE
E$WRN: SKIPA T2,["%"+FWRN,,0] ;WARNING MESSAGE
E$KIL: MOVSI T2,"?"+FKIL ;FATAL ERROR
E$COM: TXO F,FOTTY ;FORCED OUTPUT TO TTY
PUSH P,A ;SAVE ORIGINAL A
HRRZ A,0(T1) ;GET THE REAL ADDRESS OF ARGS
MOVEM T1,ERRPC ;SAVE ERROR PC
HLLM T2,ERRPC ;AND ERROR TYPE FLAG
TLZ T2,<FWRN+FTEL+FKIL> ;TURN OFF FLAGS
ANDCAM T2,ERRPC ;LEAVE ONLY FLAGS & ADDRESS IN ERRPC
HRR T2,0(A) ;RH T2 GETS TEXT ADDRESS
MOVEI T3,-1(T1) ;GIVE T3 ADDRESS OF THE CALL
HRLI T1,'MKL' ;GIVE ME AN IDENTITY
HLR T1,0(A) ;AND AN ERROR NAME
PUSHJ P,.ERMSA## ;DO THE MESSAGE
TXNN T1,JWW.FL ;WANT MORE?
JRST E$COM2 ;NO.
HLRZ T3,1(A) ;GET TYPOUT ROUTINE (IF ANY)
JUMPN T3,[ PUSHJ P,.TSPAC## ;TYPE A SPACE
MOVE T1,N ;GET DATA
PUSHJ P,0(T3) ;DO THE ROUTINE
JRST .+1] ;AND BACK INTO LINE
HRRZ T3,1(A) ;ANY CONTINATION?
JUMPE T3,E$COM2 ;NO, CONTINUE ON
POP P,A ;RESTORE A
JRST @ERRPC ;RETURN TO CALLER
E$COM2: MOVE T1,ERRPC ;RESTORE PC
TLNE T1,FTEL ;WANT TO CLOSE COMMENT?
TTCALL 1,["]"] ;YES,DO SO
HRRZ T3,1(A) ;GET CONTINUATION FIELD
POP P,A ;RESTORE A
JUMPN T3,0(T3) ;IF SHORT FORM, JUMP AROUND MESSAGE
PUSHJ P,.TCRLF## ;END THE LINE
TLNE T1,FKIL ;WAS ERROR FATAL?
JRST RSTRT1 ;YES,RESTART PROGRAM
TXZ F,FOTTY ;OFF WITH THE FLAG
JRST @ERRPC ;NO,SO CONTINUE
SUBTTL LONGER ERROR MESSAGES
MNFERR: JUMPE R,MNF2 ;MODULE NOT FOUND, IF NO NAME
MOVE N,R ;LOAD N WITH RADIX50 NAME
$KILL(MNF,Module,N$50,$MORE)
MOVEI T1,[ASCIZ/ was not found in file /]
TXNN F,FIXMOD ;IF NOT FIX MODE,ORDER
MOVEI T1,[ASCIZ/ was not found or incorrect order in file /]
PUSHJ P,.TSTRG## ;OUT
MNF1: MOVE T1,FPT ;GET POINTER TO SCAN STYLE BLOCK
PUSHJ P,.TFBLK## ;AND TALK ABOUT IT
DONERR: PUSHJ P,.TCRLF## ;
JRST RSTRT1
MNF2: $KILL(NPS,No program names were specified for file ,,$MORE)
JRST MNF1
PEFERR: MOVE N,CUREDT ;PREMATURE EOF IN PATCH FILE
$KILL(PEF,premature end-of-file during edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ in file /]
PUSHJ P,.TSTRG##
MOVE FPT,WLDTMP
JRST MNF1
FSIERR: MOVE N,[GETSTS 0,N]
DPB IOC,[POINT 4,N,12]
XCT N
$KILL(FSI,<File status error on input (>,N$OCT,$MORE)
FSERR: MOVEI T1,[ASCIZ " ) for file "]
PUSHJ P,.TSTRG## ;
JRST MNF1 ;TYPE OUT CURRENT FILE SPEC
FSOERR: GETSTS OCHN,N ;GET STATUS
MOVE FPT,OUTBEG ;SET UP REST OF MESSAGE
$KILL(FSO,<File status error on output (>,N$OCT,$MORE)
JRST FSERR
FSTERR: MOVEI IOC,TRIN ;TRANSACTION OR PATCH FILE ERROR
MOVE FPT,WLDTMP
JRST FSIERR
FSMERR: MOVEI IOC,MIN ;MASTER INPUT ERROR
MOVE FPT,INBEG
JRST FSIERR
IBTERR: MOVE N,B ;ILLEGAL BLOCK TYPE.
$KILL(IBT,<Illegal block type (> ,N$OCT,$MORE)
MOVEI T1,[ASCIZ " ) was seen in file "]
PUSHJ P,.TSTRG##
JRST MNF1 ;FINISH WITH CURRENT FILE
NECERR: $KILL(NEC,Not enough core is available)
INSERR: MOVE N,CUREDT
$KILL (SCE,Storage for patch code was exhausted in edit,N$SIX)
STOERR: MOVE N,CUREDT
$KILL(SSE,Storage for patch symbols was exhausted during edit,N$SIX)
MKMERR: MOVE N,R
$KILL(MKM,,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ pseudo-op in edit /]
PUSHJ P,.TSTRG##
MOVE T1,CUREDT
PUSHJ P,.TSIXN##
MOVEI T1,[ASCIZ/ without preceding .MODULE/]
PUSHJ P,.TSTRG##
JRST DONERR
STOPCD: $KILL(IED,<Internal error detected:
>,N$STRG,$MORE)
MOVEI T1,[ASCIZ "
At location "]
PUSHJ P,.TSTRG##
MOVE T1,-1(P) ;GET PC OF ERROR
SOS T1 ;CORRECT IT
PUSHJ P,OUTHW ;OUTPUT IT AS ADDRESS
MOVEI T1,[ASCIZ " in MAKLIB"]
PUSHJ P,.TSTRG##
MOVE N,@0(P) ;GET SIXBIT CODE
X$$IED: JRST DONERR ;
SUBTTL VARIOUS ERROR ROUTINES AND SMALL TYPE-OUT ROUTINES
PTYPO: PUSHJ P,.PSH4T## ;SAVE THE TEMPS
PUSHJ P,PTYPO1 ;DO THE OUTPUT
PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;RETURN
PTYPO1: MOVE T2,T1 ;GET NAME INTO TEMP
MOVEI T1, 6 ;SIX CHARACTERS TO GET
TLZ T2,740000 ;CLEAR CODE BITS
PTYPO2: IDIVI T2, 50 ;CONVERT TO SIXBIT CODE
HRLM T3, (P) ;STORE CHARACTER ON PD LIST
SOJLE T1,.+2 ;ALL DONE?
PUSHJ P, PTYPO2 ;NO, DIVIDE SOME MORE
HLRZ T1, (P) ;POP CHARACTERS OFF STACK
JUMPE T1, CPOPJ ;IGNORE BLANKS
CAILE T1, 12 ;LETTER OR NUMBER?
ADDI T1, 7 ;LETTER - ADD 66
ADDI T1, 57 ;NUMBER - ADD 57
CAIE T1, 135 ;PERCENT SIGN?
CAIN T1, 134 ;DOLLAR SIGN?
SUBI T1, 70 ;YES, SPECIAL CASE
CAIN T1, 133 ;PERIOD?
SUBI T1, 55 ;YES, SPECIAL CASE
PJRST BOUT ;RECURSIVE EXIT FOR MORE CHARS
CRLF: PUSH P,T1 ;SAVE T1
MOVEI T1, 15 ;CARRIAGE RETURN
PUSHJ P,BOUT ;OUTPUT IT
MOVEI T1, 12 ;LINE FEED
PUSHJ P,BOUT ;OUTPUT IT
JRST T1POPJ ;RESTORE T1 AND RETURN
; OUTPUT A FULL HALFWORD, USING 0 FILLERS
OUTHW: PUSHJ P,.PSH4T## ;SAVE TEMP ACS
LSHC T1,-22 ;SET UP THE ACS
MOVEI T3,6 ;NUMBER OF DIGITS TO OUTPUT
OUTHW1: SETZ T1, ;CLEAR T1
LSHC T1,3 ;GET AN OCTAL DIGIT
ADDI T1,"0" ;MAKE ASCII FOR OUTPUT
PUSHJ P,BOUT ;OUTPUT THE CHARACTER
SOJG T3,OUTHW1 ;BACK FOR MORE?
PUSHJ P,.POP4T## ;RESTORE THE TEMPS
POPJ P, ;AND RETURN
TYPTAB: SOSLE TABCNT ;NEED A NEW LINE?
JRST TYPTB1 ;NO
PUSHJ P,CRLF ;YES, OUTPUT ONE FIRST
MOVEI T4,TABS1-1 ;RESET THE COUNT
TXNE F,DEVTTY
MOVEI T4,TABS2-1 ;TTY
MOVEM T4,TABCNT ;AND STORE IT
TYPTB1: PUSH P,T1 ;SAVE T1
MOVEI T1,11 ;A TAB
PUSHJ P,BOUT ;OUTPUT IT
JRST T1POPJ ;AND RETURN, RESTORING T1
RSTRT: CLOSE OCHN, ;CLOSE OUTPUT CHANNELS
RSTRT1: TXO F,FOTTY ;ENSURE TTY GETS CRLF
PUSHJ P,.TCRLF## ;OUTPUT IT
JRST MAKSCN ;SCAN NEXT COMMAND LINE
SUBTTL IMPURE CODE
IFN DEBUG, <DHISIZ== . >
IFN PURESW,<
HIGH: PHASE LOW>
INGET2: IN .-., ;INPUT A BUFFER OF DATA
JRST GETIN1 ;NO ERRORS
INGET3: STATZ .-., IO.EOF ;END OF FILE?
JRST POPOUT ;YES, HIGH LEVEL EXIT
JRST FSIERR ;ERROR
DIRIOW: IOWD 200,DIRBLK ;IOWD FOR DIRECTORY INPUT
0 ;MUST BE IN LOW SEGMENT
IFN PURESW,<
LOWBLK: DEPHASE>
SUBTTL STORAGE AND BUFFERS
IFN PURESW,< RELOC LOW>
LOW:
IFN PURESW,< BLOCK LOWBLK-LOW>
PDLIST: BLOCK PD$LEN ;MASTER PUSH DOWN LIST
OFFSET: BLOCK 1 ;CCL OR REGULAR ENTRY FLAG TO SCAN
ERRPC: BLOCK 1 ;PC OF LAST CALL TO ERROR PROCESSOR
IFN DEBUG, < ;LOCATIONS FOR DEBUGGING
DEBFAI: BLOCK 1 ;NUMBER OF FAILURES DURING INTERNAL TESTS
DEBROU: BLOCK 1 ;POINTER TO ASCIZ NAME OF ROUTINE BEING TESTED
> ;NFI DEBUG
ORGFF: BLOCK 1 ;ORIGINAL CONTENTS OF .JBFF
ORGPP: BLOCK 1 ;ORIGINAL PUSHDOWN POINTER
LSTFF: BLOCK 1 ;FIRST FREE AFTER LISTING OUTPUT BUFFERS
SCNBEG: ;START OF AREA THAT CLRANS CLEARS
TMAREA: BLOCK FSSIZE ;AREA FOR STORING NAMES
SWIWRD: BLOCK 2 ;PLACE FOR SCAN TO STORE SWITCH BITS FOR NON-ARG SWITCHES
WHO: BLOCK 1 ;VALUE OF /WHO SWITCH
INBEG: BLOCK 1 ;START OF INPUT FILE-SPECS
INEND: BLOCK 1 ;END OF INPUT FILE-SPECS (FROM SCAN)
OUTBEG: BLOCK 1 ;START OF OUTPUT FILE-SPECS
OUTEND: BLOCK 1 ;END OF OUTPUT FILE-SPECS
TMPMOD: BLOCK 1 ;TEMP STOREAGE FOR MODULE NAME
MCOUNT: BLOCK 1
CURMOD: BLOCK 1 ;CURRENT MODULE READ IN
CUREDT: BLOCK 1 ;CURENT EDIT (/FIX) FOR ERROR MSG.
OPNBLK: BLOCK .RBSIZ+2+3 ;OPEN UUO BLOCK
LKPBLK=OPNBLK+3 ;AND LOOKUP BLOCK (DEFINED AS TO NOT SEPARATE THEM)
BCKBLK: BLOCK .RBSIZ+2+3 ;SAVED OUTPUT FILE SPECS
BCKFF: BLOCK 2 ;SAVED AND CURRENT JOBFF
WLDTMP: BLOCK 1 ;POINTER TO CURRENT TRANSACTION FILE
NAMCTR: BLOCK 1
TNMCTR: BLOCK 1
;**;[31] SCNEND-1 ILG 20-JUL-76
BLKCNT: BLOCK 1 ;NUMBER OF BUFFERS OUTPUT
SCNEND: ;END OF AREA THAT CLRANS CLEARS ON EACH COMMAND
SAVEAC: BLOCK 1 ;SAVE C (POINTER TO ENTBLK)
SAVEBT: BLOCK 1 ;SAVED BLOCK TYPE
SAVEP: BLOCK 1 ;SAVED PUSHDOWN POINTER
ENTBLK: BLOCK SIZE+6 ;PLACE TO SAVE LINK ITEM TYPE 'ENTRY BLOCK'
;SVEBLK AND TRCBLK OVERLAP
;BECAUSE NEVER USED AT SAME TIME
IFN FTBPT,<
ZZ==TRCMAX+2*<TRCMAX+21>/22 ;REQUIREMENTS FOR TRACE BLOCK STOREAGE
> ; NFI FTBPT
IFE FTBPT, <ZZ==0>
IFG <SIZE+6>-ZZ,<ZZ==SIZE+6> ;IF ENTRY BLOCK MAX LARGER,USE THAT
TRCBLK:
SVEBLK: BLOCK ZZ
TRCLST==.-1 ;LAST LOCATION AVAILABLE FOR TRACE STORAGE
IFN FTBPT,<
TRCPTR: BLOCK 1 ;POINTER TO CURRENT STATIC AREA
TRCVAP: BLOCK 1 ;POINTER TO CURRENT LOCATION IN VARIABLE AREA
> ;NFI FTBPT
OBUF: BLOCK 3 ;IO HEADER FOR OUTPUT
MBUF: BLOCK 3 ;INPUT BUFFER HEADER FOR MASTER FILE
TBUF: BLOCK 3 ;INPUT BUFFER HEADER FOR TRANSACTION FILE
IBUF1: BLOCK 1 ;ADDRESS OF CURRENT BYTE COUNTER
IBUF2: BLOCK 1 ;ADDRESS OF CURRENT BYTE POINTER
DSKHDR: BLOCK MTBSIZ+2 ;TWO WORDS OF OVERHEAD [P,P]+EXT
DIRBLK=DSKHDR+2
DIRNAM=DIRBLK+123 ;FILENAMES IN DTA DIRECTORY START HERE
JBFSAV: BLOCK 1 ;[67] TO SAVE .JBFF AROUND INBUF
BSZ: BLOCK 1 ;SIZE OF OLD SYMBOL BLOCK
PTGRS: BLOCK 1 ;PTGR SAVED
PTSRS: BLOCK 1 ;PTSR SAVED
RELOCS: BLOCK 1 ;ORIGINAL RELOC
SYMBLK: BLOCK ^D20 ;NEW SYMBOL BLOCK (ALSO AC STORAGE FOR SYMSRC)
XCOUNT: BLOCK 1
XPNTR: BLOCK 1
BUFSIZ: BLOCK 1
XBEG: BLOCK 2
END1: BLOCK 1 ;FIRST WORD OF END BLOCK
END2: BLOCK 2 ;SECOND WORD OF END BLOCK
TABCNT: BLOCK 1 ;COUNTS TABS LEFT FOR THIS LINE
NAMSAV: BLOCK 1
;; CONDITIONAL STOREAGE FOR BINARY PATCHING TOOL
IFN FTBPT,< ;DONT ALLOCATE IF NOT INCLUDED
FIXXP: BLOCK 1 ;PUSHDOWN POINTER ON ENTRY TO FIX PROCESSOR
CRADIX: BLOCK 1 ;CURRENT DEFAULT INPUT RADIX (MACRO)
DECNUM: BLOCK 1 ;SIMULTANEOUSLY BUILT RADIX 10. NUMBER (MACRO)
NULFLG: BLOCK 1 ;-1 IF STATMENT GENERATES NO CODE (MACRO)
PRGINC: BLOCK 1 ;-1 WHEN A PROGRAM IS IN BUFFER
BARFLG: BLOCK 1 ;-1,0,+1 FOR INSERT BEFORE,REPLACE,AFTER
SAVCOD: BLOCK 1 ;INSTR REPLACED BY "JUMPA PATCH-CODE"
SAVREL: BLOCK 1 ;SAVED RELOCATION FOR ABOVE INSTRUCTION
CPPART: BLOCK 1 ;PART OF CURRENT PATCH
CPSFLG: BLOCK 1 ;-1 IF PATCH IN LOWSEG,0 FOR HISEG
CPADDR: BLOCK 1 ;ADDRESS TO WRITE NEXT PATCH CODE WORD INTO
CPRET: BLOCK 1 ;PC TO RETURN TO AFTER PATCH
CPREPI: BLOCK 1 ;SPECIFIC NUMBER OF LOCATIONS TO SKIP ON RETURN FROM PATCH
CPINST: BLOCK 1 ;NUMBER OF INSTRUCTIONS IN CURRENT PATCH
MACBUF: BLOCK <MACSIZ+4>/5+1 ;PLACE TO PUT MACRO CODE
MACLST==.-1 ;LOCATION OF TERMINATING ZERO WORD
MACCNT: BLOCK 1 ;COUNT OF CHARACTERS LEFT
MACPTR: BLOCK 1 ;BYTE POINTER TO MACBUF
MACSV1: BLOCK 1 ;SAVED POINTER FOR RESCAN
MACSV2: BLOCK 1 ;ALSO SAVED FOR RESCAN, THE COUNT
REOL: BLOCK 1 ;"REAL" BREAK CHARACTER REPLACED BY MIC WITH $EOL VALUE
COMDON: BLOCK 1 ;TEMP FLAG FOR CODE COMPARE ROUTINE
WRDCNT: BLOCK 1 ;COUNT OF WORDS IN STRING,AFTER 1ST ONE
EVLPP: BLOCK 1 ;PDL POINTER AT ENTRY TO EVAL
LLABEL: BLOCK 1 ;R50 LAST LABEL MACRO PROCESSOR SAW
LLOFF: BLOCK 1 ;OFFSET SINCE LAST LABEL
R%V: BLOCK 1 ;EVALS RETURNS VALUE HERE
R%R: BLOCK 1 ;EVALS RETURNS RELOCATION HERE
R%S: BLOCK 1 ;EVALS RETURNS PTRS TO IST HERE
R%F: BLOCK 1 ;EVALS RETURNS FLAGS HERE
ASGSYM: BLOCK 1 ;RADIX50 SYMBOL+FLAGS TO ASSIGN VALUE TO
IFIDX: BLOCK 1 ;INDEX INTO IFXX CONDITIONAL TABLE
NSTLVL: BLOCK 1 ;CURRENT DEPTH IN CONDITIONAL PROCESSING
OPRSTK: BLOCK OPRSIZ ;BLOCK FOR STACKING OPERANDS
OPTSTK: BLOCK OPTSIZ ;BLOCK FOR STACKING OPERATORS
OPRPTR: BLOCK 1 ;SAVED PDL POINTER TO OPERANDS
OPTPTR: BLOCK 1 ;SAVED PDL POINTER TO OPERATORS
OPRTOP: BLOCK 1 ;IN CURRENT FRAME,TOP OF OPERAND STACK
OPTTOP: BLOCK 1 ;SAME FOR OPERATORS
SAVCHR: BLOCK 1 ;PLACE TO SAVE CHARACTER IN AC CC
SAVEA: BLOCK 1 ;PLACE TO SAVE ACS FOR REPEATED EDIT SEARCH
SAVEB: BLOCK 1
SAVEC: BLOCK 1
SAVED: BLOCK 1
FMZLOC: ;AREA TO ZERO WHEN NEW PROGRAM READ IN
;DO NOT SEPARATE TO LMZLOC
SPCLOC: BLOCK 1 ;POINTS TO FIRST WORD OF 1ST PROGRAM CODE BLOCK
SSTLOC: BLOCK 1 ;SAME AS ABOVE,FOR SYMBOL BLOCKS
HSILOC: BLOCK 1 ;SAME AS ABOVE FOR HI-SEGMENT BLOCK TYPE
STBLOC: BLOCK 1 ;SAME AS ABOVE , FOR TRACE TYPE BLOCK
PSLOC: BLOCK 1 ;FIRST WORD USED FOR STORING REL FILE
PELOC: BLOCK 1 ;LAST WORD USED FOR STORING REL FILE
EPCLOC: BLOCK 1 ;LOCATION OF LAST WORD IN YANKED REL FILE
ESTLOC: BLOCK 1 ;LOCATION OF LAST WORD OF LAST YANKED SYMBOL BLOCK
ETBLOC: BLOCK 1 ;LOCATION OF LAST WORD OF LAST YANKED TRACE ITEM
VERBLK: BLOCK 4 ;PLACE TO CREATE CODE BLOCK FOR VERSION NUMBER
SEB: BLOCK 4 ;PLACE TO PUT END LINK ITEM OF YANKED PROGRAM
LSYMHW: BLOCK 1 ;POINTS TO LAST HEADER WORD IN SYMBOL AREA
LCODHW: BLOCK 1 ;LAST CODE BLOCK HEADER WORD
LCADDR: BLOCK 1 ;LAST NEW CODE WORD ADDRESS
CREPTR: BLOCK 1 ;POINTER TO CURRENT WORD IN SYMBOL BLOCK
PATPTR: BLOCK 1 ;POINTER TO CURRENT WORD IN CODE BLOCK
CBHEAD: BLOCK 1 ;AOBJN PTR TO TYPE 1 INDEX TABLE
CBINIT: BLOCK 1 ;NUMBER OF CODE BLOCKS READ IN
NCBNUM: BLOCK 1 ;NUMBER OF NEW CODE BLOCKS ADDED
SBHEAD: BLOCK 1 ;AOBJN PTR TO TYPE 2 INDEX TABLE
SBINIT: BLOCK 1 ;NUMBER OF SYMBOL BLOCKS READ IN
NSBNUM: BLOCK 1 ;NUMBER OF NEW SYMBOL BLOCKS ADDED
PBHEAD: BLOCK 1 ;NUMBER OF POLISH FIXUP BLOCKS READ IN
PBINIT: BLOCK 1 ;NUMBER OF POLISH BLOCKS READ IN
NPBNUM: BLOCK 1 ;NUMBER OF CREATED POLISH BLOCKS
PBLAST: BLOCK 1 ;LAST POLISH BLOCK EXAMINED
IST: BLOCK 2*ISTMAX ;INTERIM SYMBOL TABLE
ISTLST==.-1 ;LAST LOCATION OF ABOVE
ISTMAP: BLOCK <ISTMAX+^D35>/^D36 ;MAP FOR IST
ISTALT: BLOCK <ISTMAX+^D35>/^D36 ;SAVED MAP OF IST
LMZLOC==.-1
> ; NFI FTBPT ;END OF CONDITIONAL AREA FOR BPT
LOWTOP: IFN PURESW,< RELOC>
END MAKLIB