Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0002/fail.fai
There are 6 other files named fail.fai in the archive. Click here to see a list.
TITLE FAIL
SUBTTL CONDITIONAL ASSEMBLY
;VERSION STUFF
VFAIL__12 ;REG 12/27/76
VMINOR__0
VWHO__0
VEDIT__0
LOC 137
BYTE(3)VWHO(9)VFAIL(6)VMINOR(18)VEDIT ;DEC-STYLE VERSION
RELOC 0
XALL
;ITS ASSEMBLY ADDED 6/18/73 --PJ
;CMU ASSEMBLY ADDED 10/6/73 -- MM/FW
;DWP ASSEMBLY ADDED 27 FEB 74 -- INCREASES PLEN AND DELETES LITERAL COMPARE FOR LISP
;SYMDMP SWITCH: ADDS CODE THAT WRITES ASCII VERSION OF THE SYMBOL TABLE (FOR REG)
;KI10SW CONDITIONAL FOR KI-10 MNEMONICS
;TENEX ASSEMBLY MERGED 4/26/74
;TENEX I/O ADDED 11/13/74 -- TMW
;TOPS-20 ASSEMBLY ADDED. 12/5/76 REG
DEFINE SETSW(SWIT,VAL)<IFNDEF SWIT,<SWIT__VAL&1;>SWIT__SWIT&1>
DEFINE SETSWX(SWIT,VAL)<IFNDEF SWIT,<SWIT__VAL;>SWIT__SWIT>
;THE INTENTION OF THE FOLLOWING CODE IS TO ALLOW YOU TO MAKE A NEW ASSEMBLY WITH
;THE SAME SWITCHES THAT WERE ON IN THE FAIL WITH WHICH YOU ARE ASSEMBLING.
;THE ONLY TIME THIS DOESN'T WORK IS TO ASSEMBLE A VERSION TO RUN ELSEWHERE, IN
;WHICH CASE, THE SWITCHES MUST BE SET EXPLICITLY FROM THE TTY: OR BY A HEADER FILE
IFDEF SPCWAR, <SETSW STANSW,1> ;STANFORD
IFDEF .IOT, <SETSW ITSSW,1> ;MIT
IFDEF CMUDEC, <SETSW CMUSW,1> ;CMU
IFDEF HALTF, <SETSW TENEX,1> ;TENEX or TOPS-20
IFDEF DMOVNM, <SETSW KI10SW,1> ;KI-10 OPCODES
IFOP PSTIN, <SETSW PSTISW,1> ;PSTIN JSYS EXISTS AT TENEX SITE
IFDEF KLGOT, <SETSW IMSSSW,1> ;THIS IS IMSSS
IFDEF SOUTR, <SETSW TOPS20,1> ;THIS IS TOPS-20
IFDEF AUXCAL,<SETSW TYMSW,1>
SETSW KI10SW,1 ;KI-10 MNEMONICS (ALSO KL10 MNEMONICS)
SETSW ITSSW,0 ;ITS (MIT) VERSION
SETSW CMUSW,0 ;CMU VERSION
SETSW TENEX,0 ;TENEX VERSION
SETSW TOPS20,0 ;TOPS-20 VERSION
SETSW STANSW,0 ;STANFORD VERSION
SETSW TYMSW,0 ;TYMSHARE VERSION
SETSW DWPSW,0 ;DAVID POOLE VERSION FOR LISP
SETSW SYMDMP,0 ;REG VERSION FOR HARDCOPY OF INITIAL SYMBOL TABLE
SETSW STNKSW,ITSSW
SETSW EDITSW,STANSW!CMUSW!TYMSW ;SWITCH TO ALLOW CALLING EDITOR
;NOT USEFUL WITH TOPS-10 RUN UUO WHICH CLOBBERS ACS
SETSW STOPSW,CMUSW ;SWITCH TO MAKE /R DEFAULT MODE (ONLY CMU LIKES IT)
SETSW TMPCSW,<1-<ITSSW!TENEX!TOPS20>> ;SWITCH TO ALLOW TMPCOR TYPE RPG INTERFACE
SETSW IMSSSW,0 ;PRESENTLY CONTROLS ONLY DELETIONS IN PSTIN, LOCAL JSYSES
SETSW PSTISW,0 ;ONE IF TENEX SITE HAS PSTIN JSYS
SETSW KAFLG,1 ;IF PSTIN SIMULATION IS TO RUN ON A KA
SETSW KIFLG,<1-KAFLG> ;IF PSTIN TO RUN ON KI
IFN TENEX!TOPS20,<IFN ITSSW!CMUSW!STANSW!SYMDMP,<.FATAL ILLEGAL SWITCH SETTINGS FOR TENEX>>
DEFINE ITS,<IFN ITSSW,>
DEFINE NOITS,<IFE ITSSW,>
DEFINE STINK,<IFN STNKSW,>
DEFINE NOSTINK,<IFE STNKSW,>
DEFINE TNX,<IFN TENEX!TOPS20,>
DEFINE NOTNX,<IFE TENEX!TOPS20,>
DEFINE T20,<IFN TOPS20,>
DEFINE NOT20,<IFE TOPS20,>
IFE STANSW!ITSSW!CMUSW!TENEX!TYMSW,<
OSFAIL==<SIXBIT/TOPS10/>
PRINTS /TOPS10 VERSION
/>
IFN STANSW,<
OSFAIL==<SIXBIT/SAIL/>
PRINTS /SAIL VERSION
/>
IFN TENEX,<
IFE TOPS20,<
OSFAIL==<SIXBIT/TENEX/>
PRINTS /TENEX VERSION
/>;NO TOPS20
IFN TOPS20,<
OSFAIL==<SIXBIT/TOPS20/>
PRINTS /TOPS20 VERSION
/>;TOPS20>;TENEX
IFN CMUSW,<
OSFAIL==<SIXBIT/CMU/>
PRINTS /CMU VERSION
/
>
IFN ITSSW,<
OSFAIL==<SIXBIT/ITS/>
PRINTS /ITS VERSION
/>
IFN TYMSW,<
OSFAIL==<SIXBIT/TYMSHR/>
PRINTS /TYMSHARE VERSION
/>
SUBTTL AC'S, PDL'S, AND INITIAL CONSTANTS
;AC'S
;0 FOR FLAGS
T_1
FS_T+1
O_FS+1
N_4
NA_N+1
PN_NA+1
CP_7
B_10
C_B+1
L_12
TAC_13
BC_14
FC_15
M_16
P_17
ERPLEN__100 ;NO. OF ERROR MESSAGES
SETSWX LINLEN,=120 ;CHARACTERS/LINE
SETSWX LNPP,=60 ;LINES/PAGE FOR MOST PEOPLE
IFN STANSW,<LNPP__=54>
CHRPL: LINLEN ;CHaRacters Per Line - normally =120, but reduced
;by eight for CREFFing. - JHS
HASH__=101 ;HASH SIZE
PLEN__400
IFN DWPSW,{PLEN__2000} ;FOR MACRO EXPLOSIONS (I.E., LISP!)
CPLEN__200
RPGSW: 0
RPGNEED:0 ;HACK FOR PEOPLE WHO LEAVE THE CRLF OFF THEIR COMMAND FILES
PDL: BLOCK PLEN ;PDLOV ERR PRINT WILL OVERFLOW INTO CPDL
CPDL: BLOCK CPLEN
LSTLAB: BLOCK 5 ;0=LAST LABEL DEFINED BY :
;1=BLOCK NAME AT LAST :
;2=LAST SYMBOL DEFIND BY : OR _
;3=CURRENT BLOCK NAME
;4=LOC OF LAST LABEL
PATCH: BLOCK 20 ;GOD FORBID ANYONE SHOULD EVER HAVE TO DEBUG THIS, BUT
PATCH1: BLOCK 20 ;HERE'S A LITTLE SPACE FOR YOU.
PATCH2: BLOCK 20
PATCH3: BLOCK 20
EFSLEN__500;LENGTH OF AREA FOR POLISH
EFS: BLOCK EFSLEN
UNIVSW: 0 ;SET TO -1 WHEN DOING UNIVERSAL PROGRAM
UNIVLH: 0 ;LIST HEADER FOR THE UNIVERSALS
UNIVFF: 0 ;FIRST FREE LOCATION ABOVE OU'S
UNIVBS: 0 ;BASE OF THE OU'S
U.SYM: 0 ;IN BEND, CHAIN OF SYMBOLS.
U.OPC: 0 ; OPCODES
U.MAC: 0 ; MACROS
US.S: 0 ;ADDRESS OF "FREE STORAGE LIST" FOR SYMBOLS
US.M: 0 ; FOR MACROS
US.O: 0 ; FOR OPCODES
FUNSUP: 0 ;SET TO -1 TO PREVENT .FUN FILE FROM BEING WRITTEN
IFE STANSW,< NOTNX,< NOITS,<INTTYF: 0 >>>
MACRT: BLOCK HASH
SYMTAB: BLOCK HASH
0
LITPNT: BLOCK HASH
-1
LOB: BLOCK 3
ODB: BLOCK 3
OPCDS: BLOCK HASH
TNX,<
DEFINE TSVAC (ACL) <
ZOT__0
FOR AC IN (ACL) <
MOVEM AC,TNXACS+ZOT
ZOT__ZOT+1
>>
DEFINE TRSTAC (ACL) <
ZOT__0
FOR AC IN (ACL) <
MOVE AC,TNXACS+ZOT
ZOT__ZOT+1
>>
TNXACS: BLOCK 4 ;TEMP AC STORAGE FOR JSYS CALLS
MXCOR__762777 ;MAX CORE AVAIL TO FAIL (LEAVE RM FOR BUFFS, DDT)
;DEFINE BUFFER PAGES, ETC.
ZOT__763
FOR @' BUF IN (INDBF,LSTBF,BINBF,SRCBF) <
BUF'P__ZOT
BUF__BUF'P*1000
ZOT__ZOT+1
>
TRMP__ZOT
TRM__ZOT*1000
IBUF1_SRCBF
>;TNX
IFE STANSW,<
NOTNX,<
0
IBUF1: 201,,IBUF2
BLOCK 201+1
0
IBUF2: 201,,IBUF3
BLOCK 201+1
0
IBUF3: 201,,IBUF4
BLOCK 201+1
0
IBUF4: 201,,IBUF5
BLOCK 201+1
0
IBUF5: 201,,IBUF1
BLOCK 201+1
>;NOTNX
>;IFE STANSW
IFN STANSW,<
0 ;1 WORD FOR SYSTEM
IBUF1: 201,,.+204 ;ANOTHER FOR SYSTEM
BLOCK 203 ;1 FOR SYS, 200 FOR DATA, 1 SPARE, 1 FOR SYS IN NEXT BUFFER
REPEAT =17,< 201,,.+204
BLOCK 203 >;REPEAT =17
201,,IBUF1
BLOCK 202
>;
ITS,<
SRCSTS: BLOCK 10 ;FOR CHANNEL STATUS
>;ITS
IDB: 0
INPNT: BLOCK 2
;MACRO TO MARK CURRENT PC AS LEGAL PLACE FOR MPV INTERRUPT
DEFINE LEG{FOR @! X_LEGNUM,LEGNUM{^^%$L!X::}^^LEGNUM__LEGNUM+1 }
LEGNUM__0
DEFINE DELHN <
DPB B,LSTPNT ;PUT ZERO OVER DELETE
ILDB C,INPNT ;GET NEXT
XCT DELTAB(C) ;HANDLE
ILDB C,INPNT ;GET NEXT
DPB C,LSTPNT ;DEPOSIT FOR LIST >
DEFINE GFST(A,B)
< SKIPN A,B
JSR NOFSL
>
;SRC1: SEARCH SYMBOL TABLE CHAIN
; A= AC CONTAINING SIXBIT SYMBOL NAME
; B= CONTAINS FIRST ADDR OF HASH CHAIN
; C= ADDRESS TO JRST TO ON SUCCESS
; D= INSTR. TO XCT IF YOU LOSE.
; ASSUMES 2ND WORD OF SYMBOL ENTRY IS FULL WORD OF LINK TO NEXT ENTRY
DEFINE SRC1 (A,B,C,D)
< CAMN A,(B)
JRST C
SKIPN B,1(B)
D
CAMN A,(B)
JRST C
SKIPN B,1(B)
D
JRST .-10
>
;SRC2: SEARCH SYMBOL TABLE CHAIN.
; A= AC CONTAINING 6BIT SYMBOL NAME
; B= AC CONTAINING FIRST ADR. OF HASH CHAIN.
; C= ADDRESS TO JUMP TO IF YOU FIND IT
; D= INSTR TO XCT IF YOU FAIL, IF BLANK, FALL THROUGH.
; ASSUMES 2ND WORD OF SYMBOL ENTRY CONTAINS RIGHT HALF LINK TO NEXT
DEFINE SRC2 (A,B,C,D)
< CAMN A,(B)
JRST C
HRRZ B,1(B)
JUMPN B,.-3
D
>
DEFINE ACALL ;TO CALL ASSMBL
< PUSHJ P,[POPJ CP,]>
DEFINE RETN ;TO RETURN FROM ASSMBL
< PUSHJ CP,[PUSH CP,[ASSMBL]
POP CP,-2(CP)
POPJ P,]>
DEFINE EDEPO (AC,PNT,NUM)
< MOVEI AC,177
LEG IDPB AC,PNT
MOVEI AC,NUM
LEG IDPB AC,PNT
>
DEFINE RVALUA ;TO CALL REVAL
< PUSH P,[16]
PUSHJ P,REVAL
MOVE FS,(P)
TRZE POLERF
SETZM (FS)
>
IFN CMUSW,<
OPDEF CMUDEC [CALLI -2]
OPDEF DECCMU [CALLI -3]
>
TNX,<
OPDEF OUTSTR [7B8]
OPDEF OUTCHR [10B8]
OPDEF UMOVE [100B8] ;OPDEFS FOR TENEX
OPDEF UMOVEI [101B8]
OPDEF UMOVEM [102B8]
OPDEF UMOVES [103B8]
OPDEF JSYS [104B8]
NOT20,<IFE PSTISW,< DEFINE PSTIN <JSR .PSTIN> >;IFE PSTISW>;NOT20
>;TNX
OPDEF ERROR[11B8]
OPDEF FATAL[12B8]
OPDEF FOUT[13B8]
OPDEF OUTP[14B8]
OPDEF POUT[15B8]
OPDEF TRAN[16B8]
OPDEF BBOUT[17B8]
OPDEF CREF6 [20B8]
OPDEF CREF66 [21B8]
OPDEF CREF7 [22B8]
ITS,<
OPDEF USETI [74B8]
OPDEF RELEASE [71B8]
OPDEF CLOSE [70B8]
OPDEF TTYUUO [51B8]
OPDEF PTYUUO [711B8]
OPDEF CALLI [47B8]
OPDEF INIT [41B8]
OPDEF LOOKUP [76B8]
OPDEF ENTER [77B8]
OPDEF IN [56B8]
OPDEF OUT [57B8]
OPDEF INPUT [66B8]
OPDEF OUTPUT [67B8]
OPDEF INBUF [64B8]
OPDEF OUTBUF [65B8]
OPDEF STATO [61B8]
OPDEF STATZ [63B8]
OPDEF GETSTS [62B8]
OPDEF MTAPE [72B8]
OPDEF TTCALL [TTYUUO]
OPDEF INCHRW [TTYUUO 0,]
OPDEF OUTCHR [TTYUUO 1,]
OPDEF INCHRS [TTYUUO 2,]
OPDEF OUTSTR [TTYUUO 3,]
OPDEF INCHWL [TTYUUO 4,]
OPDEF INCHSL [TTYUUO 5,]
OPDEF GETLIN [TTYUUO 6,]
OPDEF SETLIN [TTYUUO 7,]
OPDEF RESCAN [TTYUUO 10,]
OPDEF CLRBFI [TTYUUO 11,]
OPDEF CLRBFO [TTYUUO 12,]
OPDEF INSKIP [TTYUUO 13,]
OPDEF INWAIT [TTYUUO 14,]
OPDEF DEVCHR [CALLI 4]
OPDEF APRENB [CALLI 16]
OPDEF DSKPPN [CALLI 400071]
OPDEF PTWR1S [PTYUUO 7,]
OPDEF PTWRS9 [PTYUUO 12,]
IFNOP .OPEN,<
OPDEF .OPEN [41000,,0]
OPDEF .IOT [40000,,0]
OPDEF .CORE [43300,,0] ;43 6,0
OPDEF .RESET [42000,,37]
OPDEF .SUSET [43540,,0] ;43 13,0
OPDEF .DISMI [43040,,0] ;43 1,0
OPDEF .VALUE [43200,,0] ;43 4,0
OPDEF .CLOSE [42000,,7]
OPDEF .RDATE [42000,,46]
OPDEF .RTIME [42000,,45]
OPDEF .RCHST [42000,,103]
OPDEF .IOPUSH [42000,,13]
OPDEF .IOPOP [42000,,14]
OPDEF .GETSYS [42000,,23]
OPDEF .EVAL [42000,,73]
.SMASK_400006
.SSNAM_400016
.RMEMT__12
OPTCMD__40000 ;BIT IN .OPTION THAT SAYS COMMAND TO BE READ
>;IFNOP .OPEN
INTERNAL GBOUT1
EXTERNAL STKTRN
;DDT COMMAND GOODIES
DDTCMD: 0 ;DDT COMMAND FLAG
>;ITS
notnx,<
IFE STANSW,<
NOTNX,< OPDEF RESET [CALLI 0] >;NOTNX
TNX,< OPDEF RESET [104000000147] >;TNX
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF APRENB [CALLI 16]
OPDEF MSTIME [CALLI 23]
OPDEF PJOB [CALLI 30]
OPDEF RUN [CALLI 35]
OPDEF TMPCOR [CALLI 44]
>;IFE STANSW
>;notnx
EXTERN .JBREL,.JBFF,.JBSA,.JBAPR,.JBTPC,.JBCNI
SNB__400000 ;VERY HANDY NUMBER WHICH ONE GETS TIRED OF TYPING
LABLTP: 0
LABLTC: 0
LSTPNT: 0
IBUFR1_IBUF1
BLOCK: 1
DBLCK: XWD DAF,-1
PCNT: BLOCK 2 ;LEAVE CONTIGUOUS & IN THIS ORDER
OPCNT: BLOCK 2
WRD: BLOCK 2
DPCNT: BLOCK 2
NOTNX,<
;FILE-STACK
;0/ DEVICE
;1/ FILE
;2/ EXT
;3/ OLD INPNT (USELESS EXCEPT IF EXPANDING MACRO)
;4/ PPN
;5/ PAGE,,RECORD
;6/ TVFILE,,INLINE
;7/ ADDRESS OF FILE-INPNT (POINTS INTO MACRO-PDL SOMETIMES, OR TO INPNT)
FILSTL__10 ;LENGTH OF EACH FILE-STACK ENTRY
>;NOTNX
TNX,<
;FILE-STACK
;0/ JFN (SGN BIT SET IF PMAPPABLE)
;1/ OLD INPNT
;2/ USER PAGE,,FILE PAGE
;3/ TVFILE,,INLINE
;4/ ADDR OF FILE-INPNT
FILSTL__5
>;TNX
FILSTK: BLOCK FILSTL*10 ;FILE-STACK - ROOM FOR 8 LEVELS OF FILE NESTING
FILSTP: FILSTK ;POINTER TO NEXT AVAILABLE "ENTRY" IN FILE-STACK
FILSTC: 0 ;STACK DEPTH
IRECN: 0 ;RECORD NUMBER IN THE CURRENT INPUT FILE.
INPNTP: INPNT ;INPNT-POINTER. ALWAYS POINTS TO FILE-INPNT
ERCNT: 0 ;COUNT OF ERRORS ON THIS LINE.
DEFINE PSHPNT(AC)<
PUSH M,INPNTP ;POINTER TO FILE-INPNT
PUSH M,INPNT ;INPUT BYTE POINTER
MOVE AC,INPNTP
CAIN AC,INPNT
HRRZM M,INPNTP ;NEW VALUE IF WE JUST PUSHED FILE-INPNT
>
SUBTTL DEFINITION OF FLAGS FLAGS FLAGS
;AC 0 IS FLAG REGISTER
;AC 0 FLAGS (LEFT HALF):
SFL__200000 ;SCANNER AHEAD ONE CHR.
IFLG__100000 ;SCAN SAW IDENT
NFLG__40000 ;SCAN SAW NUMBER
SCFL__20000 ;SCAN SAW SPC.CHR.
FLTFL__10000 ;SCAN -- FLOATING POINT NUMBER
ESNG__4000 ;EVAL SAW ONLY SINGLE THING
ESPF__2000 ;EVAL SAW ONLY SPC CHR
REUNBF __1000 ;REVAL TEMP BIT -- UNBAL PARENS
OPFLG__400 ;AN OPCODE WAS SEEN
RELEF__200 ;REDUC -- RELOC ERROR
SOPF__100 ;SCANS -- OPCODE FOUND
PSOPF__40 ;SCANS -- PSEUDO-OP FOUND
MLFT__20 ;LEFT HALF FIXUPS SHOULD BE GENERATED
UNDF__10 ;MEVAL -- UNDEF.
PAWF__4 ;PARENS AROUND WHOLE -- MEVAL
AUNDF__2 ;ASSMBL -- PART IS UNDEFINED
;RIGHT HALF BITS:
NOFXF__200000 ;MEVAL -- DONT GENERATE FIXUPS
IOSW__100000 ;ASSMBL -- IO OPCODE
BDEV__40000 ;BIN DEVICE EXISTS
LDEV__20000 ;LIST DEVICE EXISTS
BLOSW__10000 ;TEMP BIT FOR LISTING SYNC
ADFL__4000 ;TEMP BIT USED BY ASSMBLE TO KEEP TRACK OF # OF ADRSES
FLFXF__2000 ;USED BY ASSMBL TO TELL MEVAL TO MAKE FULL WORD FIXUPS
TRBF__1000 ;ASSMBL -- TERMINATED BY ]
POLERF__400 ;POLISH ERROR
MACUNF__200 ;A MACRO WAS ENTERED (FOR UNDERLINING)
RWARN1==100 ;BAD DIGIT IN NUMBER SCAN WARNING
RWARN2==40 ;BAD DIGIT IN NUMBER SCAN WARNING
IOFLGS__BDEV!LDEV!BLOSW ;FLAGS PERTAINING TO I/O
;THE FOLLOWING ARE BITS USED TO IDENTIFY CHARACTERS IN THE TABLE
;LEFT HALF BITS:
;SNB OR 400000 (SIGN) ;NUMBER OR LETTER
NMFLG__200000 ;NUMBER
SPFL__100000 ;SPACE(TAB)
SPCLF__40000 ;ANY SPC. CHR.
ARFL__20000 ;ARITH OPERATOR
ARMD__10000 ;ARITH OP MODIFIER (-,/,&,,UN -)
ARMD1__4000 ;ADDITIONAL MODIFIER
UNOF__2000 ;UNARY OP (- , ^E (NOT))
BFL__1000 ;B
EFL__400 ;E
DLETF__200 ;DELETE
CRFG__100 ;CR RET
LBRF__40 ;< OR [
RBRF__20 ;> OR ]
.FL__10 ;.
LNFD__4 ;LINE FEED
ENMF__2 ;INDICATES THAT ANY STRING STARTING WITH
;THIS CHR. WILL BE SCANNED AS A NUMERICAL VALUE
SCRF__1 ;SPC.CHR. REQUIRING HANDLING BY SCANNER
;THE FOLLOWING ARE RIGHT HALF BITS
SHRPF__400000 ;#
BSLF__200000 ;\ (BACKSLASH) ()
UDARF__100000 ;^ OR DOWN-ARROW
LACF__40000 ;_ OR :
COMF__20000 ;,
LFPF__10000 ;(
RTPF__4000 ;)
ATF__2000 ;@
RBCF__1000
LBCF__400
INF__200 ;
EPSF__100 ;
TP2F__2 ;SUB-CLASS 2
TP1F__1 ;SUB-CLASS 1
;THE FOLLOWING ARE NUMBER (FLAG PART) BITS USED TO TELL
; ABOUT NUMBERS AND SYMBOLS
;LEFT HALF:
DEFFL__200000 ;UNDEFINED IF ON
VARF__100000 ;"VAR"--(DEFINED WITH #)
INCF__20000 ;"IN CORE" VALUE (IN ASSEMBLER CORE)
UPARF__10000 ;UP ARROW (SYMBOL ONLY)
DAF__4000 ;DOWN ARROW(SYMBOL ONLY)
DBLF__2000 ;DOUBLE _ (__) (SYMBOL ONLY)
GLOBF__1000 ;GLOBAL
INTF__400 ;INTERNAL
EXTF__200 ;EXTERNAL
UDSF__100 ;SYMBOL HAS BEEN DEFINED WITH AN UNDEFINED DEFINITION
SYMFIX__40 ;WE NEED A SYMBOL TABLE FIXUP FOR THIS SYMBOL
DBLUPF__20 ;THIS IS A DOUBLE UPARROWED SYMBOL (SYMBOL ONLY);;;;
COLONF__10 ;SYM WAS DEFINED WITH :
REFBIT__4 ;SYM HAS BEEN REFERENCED
ITS,<ANONF__2> ;THIS SYMBOL ANONYMOUS TO LOADER
SUPBIT__1 ;THIS BIT IS ON TO SUPPRESS SUPERFLUOUS DEFINITIONS
;RIGHT HALF HAS BITS FOR LEVELS AT WHICH DEFINED.
NOLIT
;RANDOM CONSTANT MEMORY CELLS
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
NOTNX,<TTCRLF:>
IFN TOPS20,<TTCRLF: >
CRLF: BYTE(7)15,12
IFE TOPS20,,<TNX,< TTCRLF:BYTE(7)37>>
STAR: BYTE(7)15,12,"*"
BEGIN OPTBL SUBTTL THE OPCODE TABLE
GLOBAL HASH
xall
FOR @$ I_0,HASH-1
< IBQ$I_0
>
DEFINE ENT $(A,B,C)
< XLIST
IBQ_'A'-'A'/HASH*HASH
IFL IBQ,<IBQ_-IBQ>
EN1(A,\IBQ,B,C)
LIST
>
;GOBBLE BIT 14 TO SIGNIFY CALLI (AT CMU)
DEFINE EN1 $(A,B,C,D)
< 'A'
IFIDN <>,<C>,<A IBQ$B>
IFDIF <>,<D>,<777767,,IBQ$B>
IFDIF <>,<C>,<IFIDN <>,<D>,<C$IBQ$B>>
IBQ$B_.-2
IFDIF <>,<D>,<D
C>
>
DEFINE EMO(A)
< FOR @$ B IN(A)
< ENT(B)
ENT(B$I)
ENT(B$M)
ENT(B$S)
>
>
IFE STANSW!ITSSW,<
DEFINE ECALLI $ (A,NUM) ;NEEDED FOR DEC SYSTEMS
< ENT(A,NUM$B12+10B17+)
>>
DEFINE ERG(A)
<FOR @$ Q IN (A)
<ENT(Q$B)
ENT(Q$I)
ENT(Q$M)
ENT(Q)
>
>
;THE EARLIER AN ENTRY APPEARS HERE, THE LONGER IT TAKES TO FIND IN SEARCHES
IFN KI10SW,< ENT(ADJSP,105B8+) ;OPCODES FOR KL10 PROCESSOR TOO
ENT(ADJBP,<<IBP 0,>>) ;IDIOT ALTERNATE NAME
ENT(DFAD,110B8+) ;OPCODES FOR KI10 PROCESSOR
ENT(DFSB,111B8+)
ENT(DFMP,112B8+)
ENT(DFDV,113B8+)
ENT(DADD,114B8+)
ENT(DSUB,115B8+)
ENT(DMUL,116B8+)
ENT(DDIV,117B8+)
ENT(DMOVE,120B8+)
ENT(DMOVN,121B8+)
IFE STANSW,< ENT(FIX,122B8+) ;> ENT(KIFIX,122B8+) ;DIFFERENT NAME
ENT(EXTEND,123B8+)
ENT(DMOVEM,124B8+)
ENT(DMOVNM,125B8+)
ENT(FIXR,126B8+)
ENT(FLTR,127B8+)
ENT(PORTAL,<<JRST 1,>>)
ENT(MAP,257B8+) >;IFN KI10SW
TNX,<
ENT(ASSIGN,0,%ASSIG) ;ASSIGN PSEUDO-OP
T20,<
ENT(ERJMP,<<JUMP 16,>>)
ENT(ERCAL,<<JUMP 17,>>)
>;T20
> ;IFN TENEX
ENT (.WCTAB,0,%WCTAB) ;.WCTAB CHAR,VAL
ENT (.RCTAB,0,%RCTAB) ;.RCTAB CHAR
ENT (.COMMO,0,%COMMN) ;.COMMON - FOR MACRO-10
ENT (.ASSIG,0,%ASSIG) ;.ASSIGN PSEUDO-OP - SAME AS FOR TENEX
ENT (.TEXT,2,%ASCII) ;.TEXT FOR LINK-10
ENT (.DIREC,0,%DIREC) ;.DIRECTIVE LIKE IN MACRO-10
ENT (.FATAL,0,%FATAL)
ENT (GDEFIN,0,%GDEF) ;LIKE ^^DEFINE
ENT (PRINTX,0,%PRNTX)
ENT (PRINTS,0,%PRNTC)
ENT (SEARCH,0,%SEAR)
ENT (UNIVER,0,%UNIV)
ENT (SUPPRE,0,%SUPPR)
ENT (ASUPPR,0,%ASUPP)
ENT (XPUNGE,0,%XPUNG)
ENT (PURGE,0,%PURGE)
ENT (.LIBRA,17,%LBLCK)
ENT (.LOAD,16,%LBLCK)
ENT (.REQUE,17,%LBLCK) ;.REQUEST LIKE .LIBRARY
ENT (.REQUI,16,%LBLCK) ;.REQUIRE LIKE .LOAD
ERG (<SETM,SETA>)
ENT (PHASE,0,PHAZ)
ENT (DEPHAS,0,DPHAZ)
ENT (PZE, ,)
ENT (PAGE,0,%PAGE)
ENT (SUBTTL,0,%SUB)
ENT (RADIX,0,%RADIX)
ENT (TITLE,0,%TITLE)
ENT (END,9,%END)
ENT (PRGEND,0,%PRGEN)
DEFINE IO(A)
<FOR B IN(A)
<ENT (B,B,%IO)
>
>
IO(<CONSO,CONSZ,BLKI,BLKO,DATAI,DATAO,CONI,CONO>)
FOR @$ QRN IN (USE,SET,NOSYM,LIT,VAR,LIST,LALL)
<ENT(QRN,0,%$QRN)
>
ENT(XLIST,-1,%LIST)
ENT(XALL,-1,%LALL)
ENT(XLIST1,1,%LIST)
ENT(LOC,0,%ORG)
ENT(RELOC,-1,%ORG)
ENT(ORG,1,%ORG)
ENT(.ORG,1,%ORG) ;.ORG - SAME AS ORG
DEFINE ENQ(A)
< FOR B IN(A)
<ENT(B)
>
>
IFE STANSW!ITSSW,<
ENQ(<CALL,INIT,ENTER,LOOKUP,USETO,USETI,UGETF,MTAPE,RELEAS>)
ENQ(<CLOSE,OUTBUF,INBUF,CALLI,STATO,STATZ,GETSTS,SETSTS>)
ENQ(<INPUT,OUTPUT>)
> ;IFE STANSW!ITSSW
NOTNX,<
IFE STANSW!ITSSW,< ;THE FOLLOWING ARE FOR ALL DEC SYSTEMS
$IBQ_-1
FOR ZOT IN (<LIGHTS>
,RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR,<DDTRL>
,WAIT,CORE,EXIT,UTPCLR,DATE,LOGIN,APRENB,<LOGOUT>
,SWITCH,REASSI,TIMER,MSTIME,GETPPN,TRPSET,TRPJEN,<RUNTIM>
,PJOB,SLEEP,SETPOV,PEEK,GETLIN,RUN,SETUWP,<REMAP>
,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR,<JOBSTR>
,STRUUO,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK,<RTTRP>
,LOCK,JOBSTS,LOCATE,WHERE,DEVNAM,CTLJOB,GOBSTR,<>
,<>,HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN,<OTHUSR>
,CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN,FRCUUO,<DEVLNM>
,PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.,TRMOP.,<RESDV.>
,UNLOK.,DISK.,DVRST.,DVURS.)
<IFDIF <>,<ZOT>,<ECALLI(ZOT,\$IBQ)>
$IBQ_$IBQ+1
>
>;IFE STANSW!ITSSW
>;NOTNX
TNX,<
;THIS ONE RESOLVES JSYS/CALLI CONFLICTS IN FAVOR OF THE JSYS
;PROBLEMS WITH RESET,WAIT,LOGIN,DEVNAM,PEEK
IFE STANSW!ITSSW,< ;THE FOLLOWING ARE FOR ALL DEC SYSTEMS
$IBQ_-1
FOR ZOT IN (<LIGHTS>
,<>,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR,<DDTRL>
,<>,CORE,EXIT,UTPCLR,DATE,<>,APRENB,<LOGOUT>
,SWITCH,REASSI,TIMER,MSTIME,GETPPN,TRPSET,TRPJEN,<RUNTIM>
,PJOB,SLEEP,SETPOV,<>,GETLIN,RUN,SETUWP,<REMAP>
,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR,<JOBSTR>
,STRUUO,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK,<RTTRP>
,LOCK,JOBSTS,LOCATE,WHERE,<>,CTLJOB,GOBSTR,<>
,<>,HPQ,HIBER,WAKE,CHGPPN,SETUUO,DEVGEN,<OTHUSR>
,CHKACC,DEVSIZ,DAEMON,JOBPEK,ATTACH,DAEFIN,FRCUUO,<DEVLNM>
,PATH.,METER.,MTCHR.,JBSET.,POKE.,TRMNO.,TRMOP.,<RESDV.>
,UNLOK.,DISK.,DVRST.,DVURS.)
<IFDIF <>,<ZOT>,<ECALLI(ZOT,\$IBQ)>
$IBQ_$IBQ+1
>
>;IFE STANSW!ITSSW
>;TNX
IFN CMUSW,< ;THE FOLLOWING ARE FOR CMU ONLY !
$IBQ_-2
FOR ZOT IN (CMUDEC,DECCMU,MSGSND,MSGPOL,JENAPR,<UNLOCK>
,STOP,TIME,UNTIME,RSTUUO,INT11,LNKRDY,PRIOR,IMPUUO)
<IFDIF <>,<ZOT>,<ECALLI(ZOT,\$IBQ)>
$IBQ_$IBQ-1
>
>;IFN CMUSW
ENT(INTERN,0,%INT)
ENT(.GOPDE,0,%GOPDE)
ENT(OPDEF,0,%OPDEF)
ENT(ENTRY,0,%ENTRY)
ENT(LINK,0,%LINK)
ENT(LINKEN,0,%ENDL)
ENT(.LINK,0,%LINK) ;.LINK - LIKE LINK
ENT(.LNKEN,0,%ENDL) ;.LNKEND - LINKEND
ENT(RADIX5,0,%RAD5)
ENT(CREF,0,%ONCRF)
ENT(XCREF,0,%OFCRF)
ENT(NOLIT,0,%NOLIT)
ENT(ARRAY,0,%ARAY)
ENT(INTEGE,0,%INTEG)
ENT(GLOBAL,0,%GLOB)
DEFINE MAT $(B)
<ENQ(<B$N,B$NE,B$NN,B$NA,B$O,B$ON,B$OE,B$OA>)
ENQ(<B$Z,B$ZE,B$ZN,B$ZA,B$C,B$CN,B$CE,B$CA>)
>
MAT(TS)
FOR @$ C IN(FAD,FSB,FMP,FDV)
<ENQ(<C,C$L,C$M,C$B,C$R,C$RL,C$RM,C$RB>)
>
ENQ(<AOBJN,AOBJP,FSC,IBP,BLT,JFCL,XCT>)
ENT(TTCALL,51B8+)
IFN STANSW,<
ENT(DPYOUT,703B8+)
ENT(INTJEN,723B8+) ;AN ALTERNATIVE TO INTDEJ
>
IFE STANSW<
ENT(OPEN,50B8+)
ENT(RENAME,55B8+)
ENT(TTYUUO,51B8+)
ENT(INCHRW,<<TTCALL 0,>>)
ENT(OUTCHR,<<TTCALL 1,>>)
ENT(INCHRS,<<TTCALL 2,>>)
ENT(OUTSTR,<<TTCALL 3,>>)
ENT(INCHWL,<<TTCALL 4,>>)
ENT(INCHSL,<<TTCALL 5,>>)
ENT(GETLIN,<<TTCALL 6,>>)
ENT(GETLCH,<<TTCALL 6,>>) ;DEC MNEMONIC
ENT(SETLIN,<<TTCALL 7,>>)
ENT(SETLCH,<<TTCALL 7,>>) ;DEC MNEMONIC
ENT(RESCAN,<<TTCALL 10,>>)
ENT(CLRBFI,<<TTCALL 11,>>)
ENT(CLRBFO,<<TTCALL 12,>>)
ENT(INSKIP,<<TTCALL 13,>>)
ENT(SKPINC,<<TTCALL 13,>>) ;ALTERNATE MNEMONIC
ENT(SKPINL,<<TTCALL 14,>>) ;DEC MNEMONIC
ENT(IONEOU,<<TTCALL 15,>>) ;NEW DEC TTCALL
ENT(IN,56B8+)
ENT(OUT,57B8+)
> ;IFE STANSW
ENT(JFFO,243B8+)
ENT(UFA,130B8+)
ENT(DFN,131B8+)
ENT(FADRI,145B8+)
ENT(FSBRI,155B8+)
ENT(FMPRI,165B8+)
ENT(FDVRI,175B8+)
IFN STANSW,< ENT(KAFIX,247B8+) >;IFN STANSW
ENT(JEN,<<JRST 12,>>)
ENT(HALT,<<JRST 4,>>)
ENT(JRSTF,<<JRST 2,>>)
ENT(JFOV,<<JFCL 1,>>)
ENT(JOV,<<JFCL 10,>>)
ENT(JCRY,<<JFCL 6,>>)
ENT(JCRY0,<<JFCL 4,>>)
ENT(JCRY1,<<JFCL 2,>>)
ENT(DEFINE,0,%DEF)
ENT(HISEG,0,%HISEG)
ENT(TWOSEG,0,%TWOSEG)
ENT(REPEAT,0,%REP)
ENT(FOR,0,%FOR)
ENT(POINT,0,%POINT)
ENT(BYTE,0,%BYTE)
ENT(OCT,10,%CON)
ENT(DEC,12,%CON)
ENQ(<JSP,JSA,JRA,ASH,ASHC,ROT,ROTC>)
ERG(<ANDCB,ORCM,ORCB,ORCA>)
MAT(TD)
DEFINE MAH $(A)
<EMO(<HRR$A,HRL$A,HLR$A,HLL$A>)
>
MAH(E)
MAH(O)
ERG(<AND,ANDCA,ANDCM,EQV,SETCA,SETCM,SETO,OR,IOR,XOR>)
ERG(<IMUL,MUL,DIV,IDIV>)
ENT(COMMEN,0,%COMMT)
ENT(EXTERN,0,%EXT)
DEFINE JSK(A)
<FOR @$ Q IN(A)
<ENQ(<Q,Q$L,Q$LE,Q$G,Q$GE,Q$N,Q$E,Q$A>)
>
>
JSK(<AOJ,SOJ,AOS,SOS>)
TNX,< ENT(JSYS)
EMO(UMOVE) >
ENT(JSR)
JSK(CAM)
MAH()
JSK(CAI)
ENQ(<LDB,DPB,ILDB,IDPB>)
EMO(<MOVS,MOVM,MOVN>)
ERG(SETZ)
ENT(BLOCK,0,%BLOCK)
ENT(EXCH)
MAH(Z)
ENT(BEGIN,0,%BEG)
ENT(BEND,0,%BEND)
JSK(SKIP)
ERG(SUB)
ENQ(<LSH,LSHC>)
ERG(ADD)
JSK(JUMP)
MAT(TR)
MAT(TL)
ENQ(<PUSH,POP,POPJ,PUSHJ>)
ENT (ASCII,0,%ASCII)
ENT (ASCIZ,1,%ASCII)
ENT (ASCID,-1,%ASCII)
ENT(SIXBIT,0,%SIX)
ENT(XWD,0,%XWD)
EMO(MOVE)
ENT(JRST)
IFN TYMSW,<ENT(AUXCAL,42B8+)
ENT(CHANIO,43B8+)
ENT(OUTPTR,<<TTCALL 17,>>)
ENT (OUTCHI,<<TTCALL 16,>>)
ENT (IONEOU,<<TTCALL 15,>>)
ENT (SKPINL,<<TTCALL 14,>>)
ENT (SKPINC,<<TTCALL 13,>>)
$IBQ_-60
FOR ZOT IN (XCHARG,SETFRC,TYMCHG,DATUUO,DDT620,VALRMT,<INTRMT>
,IDLRMT,ZAPRMT,CRERMT,AUXRED,ZAPCIR,CREAUX,REDPIP,TINASS,SETTR2,<SETTR1>
,SETTIM,INTASS,INTACT,INTENB,INTADR,HANG,CHKLIC,LEVDEF,MOVBUF,<SETMOD>
,RUNSEG,SYSDVF,DISMIS,DSKCLR,SETJAL,ONEJOB,SETMAL,GETTMC,<SETTMC>
,REDNXT,WAITCH,POKE,SETPRV,SETLIC,SETE,ATTACH,<>,<>,<>,<>,<LIGHTS>
,RESET,DDTIN,SETDDT,DDTOUT,DEVCHR,DDTGT,GETCHR,DDTRL,WAIT,CORE,<EXIT>
,UTPCLR,DATE,LOGIN,APRENB,LOGOUT,SWITCH,REASSI,TIMER,MSTIME,<GETPPN>
,TRPSET,TRPJEN,RUNTIM,PJOB,SLEEP,SETPOV,PEEK,GETLIN,RUN,<SETUWP>
,REMAP,GETSEG,GETTAB,SPY,SETNAM,TMPCOR,DSKCHR,SYSSTR,JOBSTR,<STRUUO>
,SYSPHY,FRECHN,DEVTYP,DEVSTS,DEVPPN,SEEK,RTTRP,LOCK,JOBSTS,<LOCATE>
,WHERE,DEVNAM,CTLJOB,GOBSTR,<>,<>,HPQ,HIBER,WAKE,CHGPPN,<SETUUO>
,DEFGEN,OTHUSR,CHKACC,DEVSIZ)
<IFDIF <>,<ZOT>,<ECALLI(ZOT,\$IBQ)>
$IBQ_$IBQ+1
>> ;TYMSW
;ASSEMBLE TABLE OF OPCODES THAT HAVE BEEN DEFINED THUS FAR
^OPCDS1:FOR @$ I_0,HASH-1
<IBQ$I
>
FOR @$I_0,HASH-1
<IBQ$I_0
>
DEFINE MENT (AR,BR,QR)
<'AR'
IBQ_'AR'-'AR'/HASH*HASH
IFL IBQ,<IBQ_-IBQ>
MENQ (\IBQ)
0
XWD -1,BR
QR
>
DEFINE MENQ $(A)
<IBQ$A
IBQ$A_.-2
>
FOR ROM IN (<IFE,2>,<IFG,7>,<IFN,6>,<IFL,1>,<IFGE,5>,<IFLE,3>)
<MENT (ROM,Q%IF)
>
FOR FOO IN (<IFIDN,-1,Q%IFD>,<IFDIF,0,Q%IFD>
,<IFDEF,-1,QIF%D>,<IFNDEF,0,QIF%D>
,<IFAVL,-1,QIF%A>,<IFNAVL,0,QIF%A>
,<IFMAC,-1,QIF%M>,<IFNMAC,0,QIF%M>
,<IFOP,-1,QIF%O>,<IFNOP,0,QIF%O>)
<MENT(FOO)
>
^%IOWD: 'IOWD'
IBQ_'IOWD'-'IOWD'/HASH*HASH
MENQ (\IBQ)
0
2
.+1
%IOWD
ASCII/ XWD /
BYTE (7)"-","(",177,1,0,")",",",177,1,1,"-","1",40,177,3
FOR @! X IN(.,$.)
< 'X'
IBQ__'X'-'X'/HASH*HASH
MENQ \IBQ
0
-2,,SCAN!X
SCNMPT
>
'.FNAM1' ;ENTRIES FOR .FNAM1, .FNAM2 PSEUDO-MACROS
IBQ_'.FNAM1'-'.FNAM1'/HASH*HASH
MENQ \IBQ
0
-1,,%FNM1
SCNMPT
'.FNAM2'
IBQ_'.FNAM2'-'.FNAM2'/HASH*HASH
MENQ \IBQ
0
-1,,%FNM2
SCNMPT
' .CPU.' ;.CPU. IS ALSO A PSEUDO-MACRO
IBQ_' .CPU.'-' .CPU.'/HASH*HASH
MENQ \IBQ
0
-1,,%CPU
SCNMPT
'.OSFAI' ;.OSFAIL PSEUDO-MACRO
IBQ_'.OSFAI' - '.OSFAI'/HASH*HASH
MENQ \IBQ
0
-1,,%OSFAI
SCNMPT
'.INSER' ;ENTRY FOR .INSERT AS A PSEUDO-MACRO
IBQ_'.INSER'-'.INSER'/HASH*HASH
MENQ \IBQ
0
-1,,0
%INSER
;GENERATE TABLE OF PREDFINED MACROS (INCLUDES IFS, IOWD, "." AND "$.")
^MACRT1: FOR @$ I_0,HASH-1
<IBQ$I
>
COMMENT %
FAIL symbol table format REG 3-18-74
There are three symbol tables: SYMTAB, MACRT, and OPCDS. These store
user-defined symbols, macros, and opcodes. SYMTAB is empty at the start
of an assembly. MACRT and OPCDS are initialized from MACRT1 and OPCDS1
which contain FAIL's initial symbol table, including the definition of
all opcodes, pseudo-ops, IFs, IOWD, etc. Also, the Stanford version adds
the Stanford CALLIs and IOT uuos to OPCDS1.
Every symbol table entry contains at least two words. The first word
is the right-adjusted sixbit for the symbol name. The right half of
the second word contains a pointer to the next symbol table entry, or
zero. The symbol table entries are hash coded. The hash function
is ABS(REM(sixbit symbol name, hash table length)).
OPCDS
1. initialized from OPCDS1 - permanent definitions
2. Added to by OPDEF pseudo-op
3. user-defined opcodes are deleted at block-exit.
opcodes are written into the REL file.
4. Entry format:
0: Symbol name in right-adjusted sixbit
1: code,,link to next
if code has bits 13 and 14 off, then code,,0 is the value
if code has bit 14 on then it is a predefined CALLI
if code has bit 0 on, it is a pseudo-op
otherwise, it is a user-defined opdef.
CALLIs: at Stanford, bits 0-12 are the calli index, except
if that field exceeds UCLDLN, add SLCOFF to it.
at CMU, ASH bits 0-12 right 23 bits for the calli number.
Pseudo-ops: four word entries, others are:
2: 0,,address of processing routine
3: value (i.e., argument)
Opdefs: five word entries, others are:
2: Block bit
3: Value
4: flags
MACRT
1. initialized from MACRT1 - permanent definitions
2. Added to by DEFINE pseudo-op
3. User macros are deleted at block-exit
4. Entry format:
0: Macro name, right adjusted sixbit
1: 0,,link to next
2: 0
3: code,,number of arguments
4: processing address or definition string
code is negative for a macro-pseudo op:
processing address is a dispatch. If bit
17 is off, CREF information will not be emitted
(for "." and "$."). For "." and "$." bit 12
(LBRF) must be on - see SPCCHK.
if code is zero, the right side is the number of arguments
else, the right side is an argument (as in the IFS).
the address of the definition string is given.
The macro definition string contains as its first word,
length,,back-pointer. Length is the length of the definition
string, and the back-pointer points to the entry in MACRT.
The ascii text of the macro body appear in sequential bytes.
The code 177 3 terminates the macro, the code 177 1 n denotes
argument n (first argument is number zero).
SYMTAB
1. Initially empty
2. Every symbol seen that is not a macro name or opcode
is added to this table
3. Symbols that are defined within a block and are not up-arrowed
are deleted at block exit. Symbol definitions are written into
the REL file
4. Entry format:
0: Symbol name, right adjusted sixbit
1: 0,,link to next
2: symbol flags,,block bits
3: value if defined, else fixup list
4: value flags if defined, else polish fixup list
%
BEGIN SYMWRT
;THIS IS THE CODE THAT DUMPS THE SYMBOL TABLE TO HELP REG MAKE THE FAIL MANUAL
;FAIRLY MINIMAL HACK. CALLED FROM COMMAND: ,FILE/Y
;NOT YET TENEXIZED...PROBABLY SHOULD BE...TMW
IFN SYMDMP,<
^^SYMWRT:
TRNN LDEV
HALT ;MUST HAVE A LISTING, ELSE THIS IS POINTLESS
MOVSI M,-HASH
MOVEI BC,0 ;FLAG NORMAL SYMBOL TABLE
SYMW1: SKIPE FC,OPCDS1(M) ;DOES THIS CHAIN EXIST?
PUSHJ P,SYMCH ;YES. PROCESS IT
AOBJN M,SYMW1 ;LOOP THRU ALL CHAINS.
MOVEI BC,1 ;FLAG MACRO TABLE
MOVSI M,-HASH
SYMW2: SKIPE FC,MACRT1(M)
PUSHJ P,SYMCH
AOBJN M,SYMW2
CLOSE 4,
RELEAS 4,
EXIT
SYMCH: MOVE FS,(FC) ;GET A SIXBIT THING
PUSHJ P,SYM62A ;WRITE IN ASCII
MOVEI FS,[BYTE(7)11,40,40]
PUSHJ P,SYMSTR ;TAB
JUMPN BC,SYMCH6 ;JUMP IF PROCESSING MACRO TABLE
HLLZ FS,1(FC) ;GET VALUE
TLNE FS,30 ;SPECIAL VALUE?
JRST SYMCH2 ;YES.
SYMCH0: PUSHJ P,SYMO2A ;OCTAL TO ASCII
SYMCH1: MOVEI FS,[BYTE(7)15,12]
PUSHJ P,SYMSTR
HRRZ FC,1(FC)
JUMPN FC,SYMCH
POPJ P,
SYMCH2: TLZN FS,10 ;CALLI?
JRST SYMCH3 ;NO.
ROT FS,15 ;YES. ROTATE CALLI NUMBER
CAML FS,UCLDLN
ADD FS,SCLOFF
PUSH P,FS ;SAVE NUMBER
MOVEI FS,[ASCIZ/CALLI /]
PUSHJ P,SYMSTR
MOVE T,(P)
PUSHJ P,SYMOCT ;WRITE OCTAL
POP P,FS
CAIGE FS,400000 ;STANFORD?
JRST SYMCH1 ;NO.
MOVEI FS,[ASCIZ/ S/]
JRST SYMC5A
SYMCH3: JUMPL FS,SYMCH4 ;JUMP IF PSEUDO-OP
MOVE FS,3(FC) ;MUST BE OPDEF?
JRST SYMCH0
SYMCH4: HRRZ FS,2(FC) ;SEE IF WE KNOW THIS IS SPECIAL
CAIN FS,%IO ;IO OPCODE?
JRST SYMCH5 ;YES
MOVEI FS,[ASCIZ/Pseudo-Op/]
JRST SYMC5A
SYMCH5: MOVE FS,3(FC)
MOVEI O,6 ;ONLY 6 CHARACTERS
PUSHJ P,SYMO2B
MOVEI FS,[ASCIZ %,,0 I/O%]
SYMC5A: PUSHJ P,SYMSTR
JRST SYMCH1
SYMCH6: SKIPGE FS,3(FC) ;IS THIS A PERMANENT MACRO?
JRST SYMCH7 ;NO.
MOVEI FS,[ASCIZ/Predefined Macro/]
JRST SYMC5A
SYMCH7: HRRI FS,[ASCIZ/Conditional/]
TLNN FS,1
MOVEI FS,[ASCIZ/Predefined Symbol/]
JRST SYMC5A
SYMOCT: MOVEI O,6
IDIVI T,10
HRLM T+1,(P)
SUBI O,1
JUMPE T,.+2
PUSHJ P,SYMOCT+1
MOVEI T," "
JUMPLE O,.+3
PUSHJ P,SYMOT
SOJG O,.-1
HLRZ T,(P)
ADDI T,"0"
JRST SYMOT
SYMO2A: MOVEI O,14
SYMO2B: MOVEI T,0
LSHC T,3
ADDI T,"0"
PUSHJ P,SYMOT
SOJG O,SYMO2B
POPJ P,
SYM62A: JUMPE FS,CPOPJ ;PRINT 6BIT IN FS AS ASCII
MOVEI T,0
LSHC T,6
JUMPE T,SYM62A
ADDI T," " ;MAKE ASCII, WRITE IT
PUSHJ P,SYMOT
JRST SYM62A
SYMOT: SOSG LOB+2 ;WRITE ONE CHARACTER FROM T
OUTPUT 4,
IDPB T,LOB+1
SYMOT1: POPJ P,
SYMSTR: HRLI FS,440700
ILDB T,FS
JUMPE T,SYMOT1
PUSHJ P,SYMOT
JRST SYMSTR+1
>;IFN SYMDMP
BEND SYMWRT
BEND
;ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM - STANFORD ONLY
IFN STANSW<
SYSTOP__265
CALLPT__272
SYS__400000
OPSET: MOVEI T,SYSTOP ;GET SIZE OF MEMORY
PEEK T,
PEEK T, ;INDIRECT
TDNE T,[-1,,401777]
JRST OPSLUZ
MOVSI T,-2000+1(T) ;MAKE PR WORD (WITH UWP BIT)
SETPR2 T,
JRST OPSLZ2
MOVE C,SYS+CALLPT
LDB NA,[221100,,C] ;# DEC CALLIS
MOVEM NA,UCLDLN#
SUBI NA,400000
MOVNM NA,SCLOFF#
LDB N,[331100,,C] ;TOTAL # CALLIS
CAIG N,300
CAIG N,400000(NA)
JRST OPSLUZ ;UNREASONABLE CRAP
MOVN NA,N
MOVSI T,(NA) ;MAKE AOBJN PNTR
MOVE L,SYS(C)
CAME L,['RESET ']
JRST OPSLUZ ;TABLE LOOKS WRONG
MOVE O,.JBFF
SETZM OPCDS ;INITIALIZE THIS
MOVE N,[OPCDS,,OPCDS+1] ;IT WILL KEEP TRACK OF THE ENDS OF THE HASH CHAINS
BLT N,OPCDS+HASH-1 ;AS THEY ARE NEEDED
MOVEI L,10 ;BIT FOR CALLI OPCODE ENTRIES
HRLI C,T
MOVEI B,40 ;INCREMENT
PUSHJ P,OPST1 ;DEFINE CALLIS
HRR C,@C ;GET MAJOR OPCODE TABLE ADR
MOVSI T,-40 ;# LOW UUOS
MOVEI L,40000 ;STARTING VAL
MOVEI B,1000 ;INC
PUSHJ P,OPST1 ;DEFINE LOW UUOS
HLL T,SYS-1(C) ;GET # HIGH UUOS IN LH
TLC T,-1
ADDI T,SYS ;CARRY WILL MAKE 2'S COMP
MOVEI L,700000 ;NEW INIT VAL (PNTR & INC SAME AS BEFORE)
PUSHJ P,OPST1 ;DEFINE HIGH UUOS
MOVEI B,40 ;NOW SET UP INC FOR SECONDARY OPCODES
OPSLP1: HRR C,SYS-1(C) ;GET NEXT TABLE LOC
TRNN C,-1
JRST OPSDON ;DONE IF ADR 0
HLRZ L,SYS-1(C) ;ELSE GET BASE VAL & CNT
LDB T,[50400,,L] ;GET CNT-1
MOVNI T,1(T)
MOVSI T,(T) ;MAKE AOBJN PNTR
ANDI L,777000 ;ISOLATE STARTING VAL
PUSHJ P,OPST1 ;DEFINE THIS SECONDARY SET
JRST OPSLP1 ;AND TRY FOR ANOTHER GRP
OPSDON: MOVEM O,.JBFF ;UPDATE BOTH
HRLM O,.JBSA ;COPIES OF JOBFF
OPSTX: SETOM OPSOK ;DON'T NEED TO DO THIS AGAIN
MOVEI T,
CORE2 T, ;FLUSH PR2
POPJ P,
POPJ P,
;ADDS A CALLI OR OTHER MNEMONIC AT THE END OF THE OPCDS1 TABLE.
OPST1: TRNN C,600000
TRNN C,-200
JRST OPSLUZ ;BAD ADDRESS
IORI T,SYS ;PUT OFFSET IN PNTR
OPSTL: SKIPA N,@C
LSH N,-6
TRNN N,77 ;RIGHT-JUSTIFY IF NECESSARY (SIGH)
JUMPN N,.-2 ;BUT AVOID LOOP ON 0
JUMPE N,OPSNXT ;IGNORE 0'S
LEG MOVEM N,(O) ;STORE NAME
IDIVI N,HASH
MOVM NA,NA
SKIPE PN,OPCDS(NA) ;DO WE ALREADY KNOW THE END OF THIS CHAIN?
JRST OPSTL2 ;YES
TROA PN,OPCDS1-1(NA) ;NO - FIND IT SO THESE CAN GO AT END
MOVEI PN,(FS) ;WHERE THEY WON'T INTERFERE WITH
HRRZ FS,1(PN) ;NORMAL OPCODES
JUMPN FS,.-2
OPSTL2: HRRM O,1(PN) ;LINK IN
LEG MOVSM L,1(O) ;STORE VALUE
MOVEM O,OPCDS(NA) ;THIS IS NOW END OF LIST
ADDI O,2
OPSNXT: ADDI L,(B) ;COUNT VALUE FIELD
AOBJN T,OPSTL
POPJ P,
OPSLUZ: OUTSTR [ASCIZ /GARBAGEY DATA IN SYSTEM CALL TABLE/]
OPSLZ3: OUTSTR [ASCIZ /, YOU LOSE!
/]
EXIT
OPSLZ2: OUTSTR [ASCIZ /SETPR2 TO GET CALLI NAMES FAILED/]
JRST OPSLZ3
OPSEND__. ;OPSET THRU HERE GIVEN TO FREE STORAGE AFTER THE FIRST TIME
OPSOK: 0
>;IFN STANSW
ITS,<
;CONVERT SIXBIT TO ASCII AND TYPE
FNMOUT: HRLI 1,440600 ;BYTE POINTER IN LEFT HALF
MOVEI 2,6 ;COUNT
ILDB 3,1 ;GET A BYTE
JUMPE 3,.+4 ;IGNORE BLANKS
ADDI 3," " ;MAKE ASCII
OUTCHR 3 ;TYPE IT
SOJG 2,.-4 ;FOR 6 CHARACTERS
POPJ P,
;CALLED AT INITIALIZATION TIME TO GOBBLE SYSTEM SYMBOLS INTO SYMBOL TABLE
BEGIN GETSYS
^GETSYS:MOVE TAC,[RADIX50 0,SYSYMB]
.EVAL TAC,
JRST 4,.
MOVE T,[RADIX50 0,SYSYME]
.EVAL T,
JRST 4,.
ADDI T,1
SUBB T,TAC ;LENGTH OF GETSYS AREA
ASH TAC,-1 ;GUESS AT CORE NEEDED
IMULI TAC,5
ADD TAC,.JBFF ;END OF GETSYS AREA
CAMGE TAC,.JBREL
JRST NONEED ;NO EXTRA CORE NEEDED
PUSH P,TAC
CORE TAC,
JRST 4,.
POP P,TAC
NONEED: MOVE B,TAC ;BEGINING OF GETSYS AREA
SUB B,T
MOVN C,T
HRL B,C ;AOBJN POINTER TO GETSYS AREA
PUSH P,B
MOVE C,[SIXBIT /CALLS/]
.GETSYS B,
JRST 4,.
POP P,B ;B/ AOBJN POINTER TO GETSYS AREA
MOVE C,.JBFF ;C/ POINTER TO ORIGIN OF FREE STORAGE
GETLOP: CAIL C,(B)
JRST 4,.
MOVE N,(B) ;SQUOZE
PUSHJ P,R50TOX ;CONVERT TO SIXBIT
MOVEM L,(C) ;SAVE SIXBIT
MOVE N,L
IDIVI N,HASH
MOVM NA,NA ;MAKE HASH POSITIVE.
MOVE N,1(B) ;VALUE
TDNN N,[777000,,0] ;OPCODE OR SYMBOL
JRST [ MOVEI PN,SYMTAB(NA) ;SYMBOL
SETZM 1(C)
HRLOI NA,ANONF!UPARF!DBLUPF
JRST LONG]
MOVEI PN,OPCDS(NA) ;OPCODE
TDNN N,[0,,-1] ;LONG OR SHORT ENTRY
JRST [ MOVEM N,1(C) ;SHORT
MOVEI NA,2 ;ENTRY LENGTH
JRST GETLP1]
MOVSI NA,20 ;MARK AS LONG ENTRY OPCODE
MOVEM NA,1(C)
MOVE NA,[ANONF,,1]
LONG: MOVEM NA,2(C)
MOVEM N,3(C) ;VALUE
SETZM 4(C) ;NO RELOCATION
MOVEI NA,5 ;ENTRY SIZE
GETLP1: MOVE N,(PN) ;POINTER TO CHAIN
HRRM N,1(C) ;NEW ENTRY POINTING TO CHAIN
MOVEM C,(PN) ;POINTER TO CHAIN
ADD C,NA ;UPDATE FREE STORAGE POINTER
ADD B,[1,,1]
AOBJN B,GETLOP ;MORE
MOVEM C,.JBFF
POPJ P,
;RADIX50 TO SIXBIT CONVERSION
; CALLED WITH SQUOZE IN N
; RETURNS SIXBIT IN L
; NA CLOBBERED
R50TOX: TLZ N,740000 ;CLEAR FLAGS FOR SPITE
MOVEI L,0
JUMPE N,CPOPJ ;AVOID INFINITE LOOP
R50TX1: IDIVI N,50
JUMPE NA,R50XF1 ;NULL
CAIG NA,12
JRST [ ADDI NA,'0'-1 ;ITS A DIGIT
JRST R50XF]
CAIG NA,44
JRST [ ADDI NA,'A'-13 ;ITS A LETTER
JRST R50XF]
MOVE NA,.$%-45(NA) ;SPECIAL CHARATCER
R50XF: OR L,NA
ROT L,-6
R50XF1: JUMPN N,R50TX1
TRNE L,77
POPJ P,
LSH L,-6
JRST .-3
.$%: '.'
'$'
'%'
BEND GETSYS
>;ITS
SUBTTL TENEX INITIAL SYMBOLS AND OPDEFS
TNX,<
NOT20,<
DEFINE EENT(NAME,VALUE)<
XLIST
'NAME'
600000+VALUE
LIST
>
INISMT:
EENT (LGINX1,10)
EENT (LGINX2,11)
EENT (LGINX3,12)
EENT (LGINX4,13)
EENT (LGINX5,14)
EENT (CRJBX1,20)
EENT (CRJBX2,21)
EENT (CRJBX3,22)
EENT (CRJBX4,23)
EENT (CRJBX5,24)
EENT (CRJBX6,25)
EENT (CRJBX7,26)
EENT (LOUTX1,35)
EENT (LOUTX2,36)
EENT (CACTX1,45)
EENT (CACTX2,46)
EENT (EFCTX1,50)
EENT (EFCTX2,51)
EENT (EFCTX3,52)
EENT (GJFX1,55)
EENT (GJFX2,56)
EENT (GJFX3,57)
EENT (GJFX4,60)
EENT (GJFX5,61)
EENT (GJFX6,62)
EENT (GJFX7,63)
EENT (GJFX8,64)
EENT (GJFX9,65)
EENT (GJFX10,66)
EENT (GJFX11,67)
EENT (GJFX12,70)
EENT (GJFX13,71)
EENT (GJFX14,72)
EENT (GJFX15,73)
EENT (GJFX16,74)
EENT (GJFX17,75)
EENT (GJFX18,76)
EENT (GJFX19,77)
EENT (GJFX20,100)
EENT (GJFX21,101)
EENT (GJFX22,102)
EENT (GJFX23,103)
EENT (GJFX24,104)
EENT (GJFX25,105)
EENT (GJFX26,106)
EENT (GJFX27,107)
EENT (GJFX28,110)
EENT (GJFX29,111)
EENT (GJFX30,112)
EENT (GJFX31,113)
EENT (GJFX32,114)
EENT (GJFX33,115)
EENT (OPNX1,120)
EENT (OPNX2,121)
EENT (OPNX3,122)
EENT (OPNX4,123)
EENT (OPNX5,124)
EENT (OPNX6,125)
EENT (OPNX7,126)
EENT (OPNX8,127)
EENT (OPNX9,130)
EENT (OPNX10,131)
EENT (OPNX11,132)
EENT (OPNX12,133)
EENT (OPNX13,134)
EENT (OPNX14,135)
EENT (OPNX15,136)
EENT (OPNX16,137)
EENT (OPNX17,140)
EENT (OPNX18,141)
EENT (OPNX19,142)
EENT (OPNX20,143)
EENT (OPNX21,144)
EENT (OPNX22,145)
EENT (DESX1,150)
EENT (DESX2,151)
EENT (DESX3,152)
EENT (DESX4,153)
EENT (DESX5,154)
EENT (DESX6,155)
EENT (DESX7,156)
EENT (CLSX1,160)
EENT (CLSX2,161)
EENT (RJFNX1,165)
EENT (RJFNX2,166)
EENT (RJFNX3,167)
EENT (DELFX1,170)
EENT (SFPTX1,175)
EENT (SFPTX2,176)
EENT (SFPTX3,177)
EENT (CNDIX1,200)
EENT (CNDIX2,201)
EENT (CNDIX3,202)
EENT (CNDIX4,203)
EENT (CNDIX5,204)
EENT (SFBSX1,210)
EENT (SFBSX2,211)
EENT (IOX1,215)
EENT (IOX2,216)
EENT (IOX3,217)
EENT (IOX4,220)
EENT (IOX5,221)
EENT (IOX6,222)
EENT (PMAPX1,240)
EENT (PMAPX2,241)
EENT (SPACX1,245)
EENT (FRKHX1,250)
EENT (FRKHX2,251)
EENT (FRKHX3,252)
EENT (FRKHX4,253)
EENT (FRKHX5,254)
EENT (FRKHX6,255)
EENT (GTABX1,267)
EENT (GTABX2,270)
EENT (RUNTX1,273)
EENT (STADX1,275)
EENT (STADX2,276)
EENT (ASNDX1,300)
EENT (ASNDX2,301)
EENT (ASNDX3,302)
EENT (CSYNX1,312)
EENT (ATACX1,320)
EENT (ATACX2,321)
EENT (ATACX3,322)
EENT (ATACX4,323)
EENT (ATACX5,324)
EENT (DCHRX1,330) ;USED ?
EENT (STDVX1,332)
EENT (DEVX1,335)
EENT (DEVX2,336)
EENT (DEVX3,337)
EENT (MNTX1,345)
EENT (MNTX2,346)
EENT (MNTX3,347)
EENT (TERMX1,350)
EENT (ATIX1,352)
EENT (ATIX2,353)
EENT (DTIX1,355)
EENT (TTYX1,360)
EENT (CFRKX2,362)
EENT (CFRKX3,363)
EENT (KFRKX1,365)
EENT (KFRKX2,366)
EENT (RFRKX1,367)
EENT (GFRKX1,371)
EENT (GETX1,373)
EENT (GETX2,374)
EENT (SFRVX1,377)
EENT (NOUTX1,407)
EENT (NOUTX2,410)
EENT (IFIXX1,414)
EENT (IFIXX2,415)
EENT (IFIXX3,416)
EENT (GFDBX1,424)
EENT (GFDBX2,425)
EENT (GFDBX3,426)
EENT (CFDBX1,430)
EENT (CFDBX2,431)
EENT (CFDBX3,432)
EENT (CFDBX4,433)
EENT (DUMPX1,440)
EENT (DUMPX2,441)
EENT (DUMPX3,442)
EENT (DUMPX4,443)
EENT (RNAMX1,450)
EENT (RNAMX2,451)
EENT (BKJFX1,454)
EENT (TIMEX1,460)
EENT (ZONEX1,461)
EENT (ODTNX1,462)
;463 FREE
EENT (DILFX1,464)
EENT (TILFX1,465)
EENT (DATEX1,466)
EENT (DATEX2,467)
EENT (DATEX3,470)
EENT (DATEX4,471)
EENT (DATEX5,472)
EENT (DATEX6,473)
EENT (TMONX1,515)
EENT (SMONX1,515)
EENT (CPRTX1,520)
EENT (SACTX1,530)
EENT (SACTX2,531)
EENT (SACTX3,532)
EENT (SACTX4,533)
EENT (GACTX1,540)
EENT (GACTX2,541)
EENT (FFUFX1,544)
EENT (FFUFX2,545)
EENT (FFUFX3,546)
EENT (DSMX1,555)
EENT (RDDIX1,560)
EENT (SIRX1,570)
EENT (SSAVX1,600)
EENT (SSAVX2,601)
EENT (SEVEX1,610)
EENT (WHELX1,614)
EENT (CRDIX1,620)
EENT (CRDIX2,621)
EENT (CRDIX3,622)
EENT (CRDIX4,623)
EENT (CRDIX5,624)
EENT (CRDIX6,625)
EENT (GTDIX1,640)
EENT (GTDIX2,641)
EENT (FLINX1,650)
EENT (FLINX2,651)
EENT (FLINX3,652)
EENT (FLINX4,653)
EENT (FLOTX1,660)
EENT (FLOTX2,661)
EENT (FLOTX3,662)
EENT (FDFRX1,700)
EENT (FDFRX2,701)
EENT (ATPX1,710)
EENT (ATPX2,711)
EENT (ATPX3,712)
EENT (ATPX4,713)
EENT (ATPX5,714)
EENT (ATPX6,715)
EENT (ATPX7,716)
EENT (ATPX8,717)
EENT (ATPX9,720)
EENT (ATPX10,721)
EENT (ATPX11,722)
EENT (ATPX12,723)
EENT (ATPX13,724)
EENT (CVSKX1,730)
EENT (CVSKX2,731)
EENT (DPX1,734)
EENT (DPX2,735)
EENT (STRDX1,740)
EENT (STRDX2,741)
EENT (STRDX3,742)
EENT (STTX1,744)
;ADD JSYS ERROR CODES HERE
EENT (ILINS1,770)
EENT (ILINS2,771)
EENT (ILINS3,772)
INISME: 0 ;ZERO TERMINATES
BLOCK 40 ;PATCH SPACE FOR 16 MORE
>;NOT20 ;FOR TOPS-20 YOU SHOULD SEARCH MONSYM
DEFINE JENT(NAME,NUMBER)<
XLIST
'NAME'
JSYS NUMBER
IFNOP NAME,<GDEFINE NAME <104B8+NUMBER>>
LIST
>
TNXOPS: ;TABLE OF TENEX OPDEFS STARTS HERE
$IBQ_0
FOR ZOT IN (<>,LOGIN,CRJOB,LGOUT,CACCT,EFACT,SMON,<TMON>
,GETAB,ERSTR,GETER,GJINF,TIME,RUNTM,SYSGT,<GNJFN>
,GTJFN,OPENF,CLOSF,RLJFN,GTSTS,STSTS,DELF,<SFPTR>
,JFNS,FFFFP,RDDIR,CPRTF,CLZFF,RNAMF,SIZEF,<GACTF>
,STDIR,DIRST,BKJFN,RFPTR,CNDIR,RFBSZ,SFBSZ,<SWJFN>
,BIN,BOUT,SIN,SOUT,RIN,ROUT,PMAP,<RPACS>
,SPACS,RMAP,SACTF,GTFDB,CHFDB,DUMPI,DUMPO,<DELDF>
,ASND,RELD,CSYNO,PBIN,PBOUT,PSIN,PSOUT,<MTOPR>
,CFIBF,CFOBF,SIBE,SOBE,DOBE,GTABS,STABS,<RFMOD>
,SFMOD,RFPOS,RFCOC,SFCOC,STI,DTACH,ATACH,<DVCHR>
,STDEV,DEVST,MOUNT,DSMNT,INIDR,SIR,EIR,<SKPIR>
,DIR,AIC,IIC,DIC,RCM,RWM,DEBRK,<ATI>
,DTI,CIS,SIRCM,RIRCM,RIR,GDSTS,SDSTS,<RESET>
,RPCAP,EPCAP,CFORK,KFORK,FFORK,RFORK,RFSTS,<SFORK>
,SFACS,RFACS,HFORK,WFORK,GFRKH,RFRKH,GFRKS,<DISMS>
,HALTF,GTRPW,GTRPI,RTIW,STIW,SOBF,RWSET,<GETNM>
,GET,SFRKV,SAVE,SSAVE,SEVEC,GEVEC,GPJFN,<SPJFN>
,SETNM,FFUFP,DIBE,FDFRE,GDSKC,LITES,TLINK,<STPAR>
,ODTIM,IDTIM,ODCNV,IDCNV,NOUT,NIN,STAD,<GTAD>
,ODTNC,IDTNC,FLIN,FLOUT,DFIN,DFOUT,<>,<>
,CRDIR,GTDIR,DSKOP,SPRIW,DSKAS,SJPRI,STO,<>
,<>,<>,<>,<>,<>,<>,<>,<>
,ASNDP,RELDP,ASNDC,RELDC,STRDP,STPDP,STSDP,<RDSDP>
,WATDP,<>,<>,<>,ATPTY,CVSKT,CVHST,<FLHST>
,GCVEC,SCVEC,STTYP,GTTYP,BPT,GTDAL,WAIT,<HSYS>
,USRIO,PEEK,MSFRK,ESOUT,SPLFK,ADVIS,JOBTM,<DELNF>
,SWTCH)
<IFDIF <ZOT>,<>,<JENT(ZOT,\$IBQ)>
$IBQ_$IBQ+1
>
T20,<
$IBQ_500
FOR ZOT IN (RSCAN,HPTIM,CRLNM,INLNM,LNMST,RDTXT,SETSN,<GETJI>
,MSEND,MRECV,MUTIL,ENQ,DEQ,ENQC,SNOOP,<SPOOL>
,ALLOC,CHKAC,TIMER,RDTTY,TEXTI,UFPGS,SFPOS,<SYERR>
,DIAG,SINR,SOUTR,RFTAD,SFTAD,TBDEL,TBADD,<TBLUK>
,STCMP,SETJB,GDVEC,SDVEC,COMND,PRARG,GACCT,<LPINI>
,GFUST,SFUST,ACCES,RCDIR,RCUSR)
<IFDIF <ZOT>,<>,<JENT(ZOT,\$IBQ)>
$IBQ_$IBQ+1
>
JENT(THIBR,770) ;Temporary JSYS Definitions
JENT(TWAKE,771)
JENT(MRPAC,772)
JENT(SETPV,773)
JENT(MTALN,774)
JENT(TTMSG,775)
>;T20
IFN IMSSSW,< ;LOCAL JSYSES FOR IMSSS INSTALLATION
$IBQ_600
FOR ZOT IN (PBTIN,TTCVT,KIDNO,LOGSV,DATSV,SCEDR,SCEDS,CNTSZ,SYSLK,<PSTIN>
,RAND,KLGOT,PTINF,GTINF,SETWS,CLRWS,AUTWS,RDWS,CLAWS,KLGIN,DEVCT,<DELCH>
,SJPCT,RJPCT,IIT,PARRD,PARST,STCHA,GTBLT,DRMOP,RECO,RDREC)
<IFDIF <ZOT>,<>,<JENT(ZOT,\$IBQ)>
$IBQ_$IBQ+1>
JENT(DATSX,660)
JENT(FONCT,661)
JENT(SETAU,677)
>;IMSSS
NOT20,<
JENT(MRPAC,772)
JENT(TTMSG,775)
JENT(EXEC,777)
>;NOT20
0 ;ZERO TO END THE TABLE
^INISM: MOVEI NA,1
MOVEM NA,OPDTMP ;BLOCK NUMBER OF DEFINITION
MOVSI NA,NONEM ;USUAL BITS FOR WRD+1
MOVEM NA,WRD+1
MOVEI NA,TNXOPS-2 ;ADDRESS OF THE TABLE
PUSH P,NA
STNXP1: AOS (P) ;GET THE INDEX
AOS NA,(P)
SKIPN L,(NA) ;GET THE SIXBIT
JRST STNXP2 ;ALL DONE
MOVE N,1(NA)
MOVEM N,WRD
PUSHJ P,OPDINS ;INSERT "OPDEF"
MOVSI NA,SUPBIT
IORM NA,2(PN) ;SET SUPPRESS BIT IN NEW DEFINITION
JRST STNXP1
STNXP2: SUB P,[1,,1]
SETZM WRD
T20,< POPJ P, >;TOPS-20 HAS NO OTHER SYMBOLS
NOT20,<
MOVEI T,INISMT ;ADD TENEX INITIAL SYMBOLS
INISML: GFST (FS,FSTPNT) ;GET FREE STORAGE.
SKIPN N,0(T) ;ANY SYMBOLS LEFT?
POPJ P, ;NOPE. RETURN.
MOVEM N,0(FS) ;STORE SYMBOL NAME IN FS BLOCK
IDIVI N,HASH ;CALC. HASH CODE
MOVMS NA
MOVE L,SYMTAB(NA) ;LINK THIS FS BLOCK INTO SYMBOL TABLE
MOVEM FS,SYMTAB(NA)
EXCH L,1(FS)
MOVEM L,FSTPNT ;DELINK BLOCK FROM FREE LIST
MOVE L,1(T)
MOVEM L,3(FS) ;STORE VALUE
SETZM 4(FS) ;NO RELOCATION
MOVE L,[SUPBIT!UPARF,1] ;OUTER BLOCK, UPARROWED, SUPPRESSED
MOVEM L,2(FS)
ADDI T,2
JRST INISML
>;NOT20
>;TNX
BEGIN INIT SUBTTL DEVICE INITIALIZATION
^FNREAD: JSR IN ;FILE NAME READER INSTRUCTION (GETS CLOBBERED)
;THIS IS WHAT WE CALL TO SCAN FILE NAMES FROM THE INPUT STREAM
^AFSCAN:PUSHJ P,SCAN1
MOVE 2,C ;MOVE CHARACTER TO RIGHT AC
POPJ P,
NOTNX,<NOITS,<
BEGIN NAME
;CALL WITH:
;RETURN: SIXBIT LEFT ADJUSTED IN 6,
;SIXBIT (OR OCTAL) RIGHT ADJUSTED IN SVNAM. OCTAL IN 13 (NOT STANSW!IMSSSW).
;DELIMITER IN 2
;YOU MUST NOT CLOBBER AC #7 = CP!!!
^NAME: 0
IFE STANSW!IMSSSW,< MOVEI 13,0> ;SAIL and IMSSS like sixbit ppns
NA1: XCT FNREAD
CAIE 2,11
CAIN 2," "
JRST NA1 ;SKIP BLANKS AND TABS
MOVEM 5,NAMES5# ;SAVE AN AC
TDZA 6,6 ;INITALIZE 6BIT AC AND SKIP
LOOP1: XCT FNREAD ;GET A CHR
CAIE 2,"."
SKIPL 5,CTAB(2) ;CHECK FOR NUMBER OR LETTER
JRST STOPN ;NO, SOME DELIMITER
TLNE 6,770000 ;SEEN 6 CHARS YET?
JRST LOOP1 ;YES, IGNORE THIS
LSH 6,6 ;MAKE ROOM
ANDI 5,77 ;SIXBIT ONLY, FROM CHAR TABLE
IORI 6,(5)
MOVEI 2,40(5) ;GET UPPER CASE VERSION OF CHAR
IFE STANSW!IMSSSW,< LSH 13,3 ;MAKE OCTAL PPN IN 13
IORI 13,-'0'(5) ;MAKE OCTAL PPN>
JRST LOOP1
STOPN: MOVE 5,NAMES5 ;RESTORE AC
JUMPE 6,@NAME ;IF 0 RETURN
JRST .+2
STOPN2: XCT FNREAD
CAIE 2," "
CAIN 2,11
JRST STOPN2 ;DON'T STOP AT BLANK OR TAB. GET REAL DELIMITER
IFE STANSW!IMSSSW,< MOVEM 13,SVNAM> ;SAVE OCTAL FOR PPNS
IFN STANSW!IMSSSW,< MOVEM 6,SVNAM> ;SAVE RIGHT ADJUSTED SIXBIT FOR PPNS
STOPN1: TLNE 6,770000 ;NOW, LEFT JUSTIFY
JRST @NAME
LSH 6,6
JRST STOPN1
IFN CMUSW,<
^RDPPN: 0
SETZM PPNBUF
SETZM PPNBUF+1
SETZM PPNBUF+2
MOVEM 5,RDPTMP#
RDPPN1: XCT FNREAD
CAIE 2," "
CAIN 2,11
JRST RDPPN1 ;SKIP BLANKS AND TABS
MOVEI 5,=13 ;MAX CHARACTER COUNT
SKIPA 6,[440700,,PPNBUF]
RDPPN2: XCT FNREAD
CAIN 2,","
JRST RDPPOK ;COMMA IS LEGAL
SKIPL CTAB(2)
JRST RDPPX ;OTHER DELIMS NOT.
CAIL 2,"A"+40
CAILE 2,"Z"+40
JRST .+2
SUBI 2,40 ;MAKE UPPER CASE
RDPPOK: IDPB 2,6
SOJG 5,RDPPN2
RDPPX: MOVE 6,[4,,PPNBUF]
CMUDEC 6, ;CONVERT STRING TO 36 BIT NUMBER
JFCL ;(BARF?) (SOMEONE, SOMEWHERE WILL LOSE)
MOVE 5,RDPTMP
JRST @RDPPN
PPNBUF: BLOCK 3>
BEND NAME
BEGIN GETFIL
;RETURNS +1 IF LOSE
; +2 IF WIN. 1:DEVICE, 5:FILE, 3: EXT, 4: PPN
^SVNAM: 0
^^GETFIL:0
JSR NAME ;READ A NAME
JUMPE 6,@GETFIL ;RETURN IF NONE THERE
AOS GETFIL ;ELSE SET FOR SKIP RETURN
CAIE 2,":" ;DEVICE NAME?
JRST NODEV ;NO, TRY FILE NAME
MOVE 1,6 ;SET DEVICE
JSR NAME ;GET ANOTHER NAME
JUMPE 6,@GETFIL ;NONE, END (PTR: IS LEGAL)
NODEV: MOVE 5,6 ;FILE NAME
CAIE 2,"." ;MAYBE EXTENSION?
JRST NOEXT ;NO.
JSR NAME ;GET EXT - NULL EXT IS NOT AN ERROR.
HLLZ 3,6 ;SET EXTENSION (CLEARS RH BITS FROM 3)
NOEXT: CAIE 2,"<" ;ALLOW BROKETS TO DENOTE PPNS
CAIN 2,"[" ;CHECK FOR PPN
JRST INPPN ;READ PPN
JRST @GETFIL ;NO, RETURN
INPPN:
IFE CMUSW,< JSR NAME ;GET LEFT HALF
JUMPE 6,ERR3 ;NOT THERE
HRLZ 4,SVNAM ;GET LEFT HALF
CAIE 2,"," ;MUST BE THERE
JRST ERR3
JSR NAME ;REPEAT FOR RIGHT HALF
HRR 4,SVNAM >
IFN CMUSW,< JSR RDPPN >
CAIE 2,">" ;ALLOW BROKET
CAIN 2,"]" ;] PRESENT?
XCT FNREAD ;YES SKIP IT. (NOT AN ERROR TO OMIT)
JRST @GETFIL
BEND GETFIL
>;NOITS>;NOTNX
TNX,<
;TGETF -- GET TENEX FILE NAME FROM INPUT STREAM.
;PRESENTLY CALLED ONLY BY INITL, .INSERT CODE BUT MAY BE USED BY .LOAD, .LIB
; IF ANYBODY EVER FIXES THE LOADER...
;VERY QUICK AND DIRTY. NO INTERACTIVE USE OF GTJFN BECAUSE OF SWITCHES...
^^TGETF: 0
XCT FNREAD
CAIE 2,11 ;TAB
CAIN 2," "
JRST .-3 ;SKIP LEADING SPACES, TABS
SKIPA 1,[POINT 7,GTNAM]
TGETF1: XCT FNREAD
JSR ISTRM ;CHECK FOR 'TERMINAL' IN SWITCH CONTEXT
JRST TGETFX ;YEP
CAIE 2,15 ;THROW OUT CR
IDPB 2,1 ;SAVE CHAR FOR GTJFN IN INITIT
JRST TGETF1 ;BACK FOR MORE
TGETFX: CAME 1,[POINT 7,GTNAM]
AOS TGETF ;IF SUCCESSFUL
JRST @TGETF
;PRESENTLY CALLED FROM .LIBRARY (.LOAD) ONLY.
^^TGETFY: XCT FNREAD ;slurp something
CAIE 2,11 ;TAB
CAIN 2," "
JRST TGETFY ;SKIP LEADING SPACES, TABS
SKIPA 1,[POINT 7,GTNAM]
TGETY1: XCT FNREAD
CAIE 2,15 ;also break on CR for .LOAD
JSR ISTRM ;CHECK FOR 'TERMINAL' IN SWITCH CONTEXT
JRST TGETY2 ;YEP
IDPB 2,1 ;SAVE CHAR FOR GTJFN IN INITIT
JRST TGETY1 ;BACK FOR MORE
TGETY2: CAME 1,[POINT 7,GTNAM]
AOS (P) ;SOMETHING WAS SEEN
TLO SFL ;SET SCANNER AHEAD
POPJ P,
ISTRM: 0
MOVE 6,[XWD -TRMTL,TRMTBL]
CAME 2,(6)
AOBJN 6,.-1 ;IF MORE TO DO
SKIPL 6
AOS ISTRM ;NON-TERMINAL EXIT
JRST @ISTRM
TRMTBL: "/"
"_"
","
"="
"("
"@"
"!"
" "
11 ;TAB
12 ;LF, BECAUSE RPG FLUSHES CR
")" ;FOR SCAN IN SEARCH PSEUDO OP
TRMTL__.-TRMTBL
>;TNX
ITS,< BEGIN ITSSCN ;ITS STYLE COMMAND LINE SCANNER
DEV_1
FN1_5
FN2_3
SNAME_4
BREAK_2
CHAR_7
ACPTR_13
AC_6
^^LIMBO: 0 ;SCANNER READ AHEAD CHARACTER
;SCANNER WILL NOT LET US LEAVE UNTIL ZERO
GETCC: 0 ;GET CHARACTER FOR COMMAND LINE SCANNER
SKIPE LIMBO
SKIPA BREAK,LIMBO
XCT FNREAD ;READ NEXT CHARACTER (USUALLY JSR IN).
SETZM LIMBO
JRST @GETCC
NAME: 0 ;BREAK OFF WORD FROM INPUT STREAM
NA1: JSR GETCC
CAIE BREAK," "
CAIN BREAK,11
JRST NA1 ;IGNORE LEADING BLANKS AND TABS
MOVE ACPTR,[440600,,AC] ;DEPOSIT LEFT ADJUSTED SIXBIT
TDZA AC,AC
NAME1: JSR GETCC ;GET CHARACTER
JSR BRKTST ;CHECK FOR A BREAK
JRST NAMBRK ;THIS IS A BREAK CHARACTER
NAME2: TLNE ACPTR,770000 ;IGNORE EVERYTHING AFTER 6 CHARACTERS
IDPB CHAR,ACPTR
JRST NAME1
NAMBRK: JUMPN CHAR,@NAME ;NO TRAILING SPACES
NAMBR1: JSR GETCC
CAIE BREAK," "
CAIN BREAK,11
JRST NAMBR1 ;FLUSH TRAING SPACES
JSR BRKTST ;IS THIS A REAL BREAK?
JRST @NAME ;YES. RETURN THAT BREAK CHARACTER
MOVEM BREAK,LIMBO ;NO. WE CONSIDER THAT SPACE WAS THE BREAK.
MOVEI BREAK," " ;PUT THE OTHER BREAK BACK (INTO LIMBO) FOR LATER
JRST @NAME
;CONVERTS BREAK TO SIXBIT AND PUTS RESULT IN CHAR
;^Q QUOTES NEXT CHARACTER
;FAILS TO SKIP ON BREAK CHARACTER <NON-SIXBIT SPACE , : ; @ _ ( ) >
BRKTST: 0
CAIN BREAK,11
MOVEI BREAK," "
JSR SIXTST
JUMPL CHAR,[ CAIE BREAK,21 ;^Q
JRST @BRKTST ;NON-SIXBIT BREAKS US
JSR GETCC
JSR SIXTST
JUMPL CHAR,@BRKTST ;NON-SIXBIT
JRST BRKT1]
JUMPE CHAR,@BRKTST
CAIE CHAR,','
CAIN CHAR,'_'
JRST @BRKTST
CAIE CHAR,':'
CAIN CHAR,';'
JRST @BRKTST
CAIE CHAR,'('
CAIN CHAR,')'
JRST @BRKTST
CAIE CHAR,'@'
CAIN CHAR,'/'
JRST @BRKTST
CAIE CHAR,'+' ;MAKE + AND = WORK (ALTERNATIVES TO , AND _)
CAIN CHAR,'='
JRST @BRKTST
BRKT1: AOS BRKTST ;WHEW!
JRST @BRKTST
;CONVERT BREAK TO SIXBIT
SIXTST: 0
MOVNI CHAR,1
CAIL BREAK," "
CAILE BREAK,"_"
JRST SIXT1 ;MIGHT BE LOWER CASE
MOVEI CHAR,-" "(BREAK)
JRST @SIXTST
SIXT1: CAIL BREAK,"a"
CAILE BREAK,"z"
JRST @SIXTST
MOVEI CHAR,-100(BREAK) ;LOWER CASE TO SIXBIT
JRST @SIXTST
;THIS ROUTINE SCANS COMMAND LINE FOR FILE SPECIFICATION
^^GETFIL:0
JSR NAME ;GET A WORD
JUMPE AC,@GETFIL
AOSA GETFIL ;ARRANGE FOR SKIP RETURN
GETF1: JSR NAME
JUMPE AC,@GETFIL
CAIE BREAK,":" ;DEVICE NAME?
JRST GETF2 ;NO.
MOVE DEV,AC
JRST GETF1
GETF2: CAIE BREAK,";" ;USER NAME?
JRST GETF3 ;NO
MOVE SNAME,AC ;REMEMBER USER NAME.
JRST GETF1 ;(SET SNAME WITH DSKPPN UUO AT INITIT)
GETF3: CAIE BREAK," " ;BREAK IS BLANK?
JRST GETF4
JUMPN FN1,[MOVE FN2,AC
JRST GETF1]
MOVE FN1,AC
JRST GETF1
GETF4: JUMPN FN1,[MOVE FN2,AC
JRST @GETFIL]
MOVE FN1,AC
JRST @GETFIL
BEND ITSSCN
>;ITS
BEGIN INITIT
;IO CHANNELS: 2: INPUT, 3: BINARY, 4: LISTING, 6: RPG OR COMMAND
; CHANNEL 1 IS USED FOR UNIVERSAL FILE I/O
NOTNX,<
^^INITIT:0
DPB 6,[POINT 4,INIT1,12] ;CLOBBER IO CHANNEL IN INIT
SETZM FPPN ;IN CASE WE DO NOT STORE
MOVEM 1,NAM ;SET NAME
MOVEM 1,LFDEV ;SAVE DEVICE (LAST FILE DEVICE)
MOVEM 5,FNAM ;AND FILE NAME
ITS,< MOVEM 3,FEXT ;WHOLE WORD FOR FNAM2>
NOITS,< HLLZM 3,FEXT ;HALF WORD FOR EXTENSION
CAIGE 6,5 ;PPNS FOR SPECIAL ONES
CAIN 6,2 > ;NO PPN UNLESS INPUT
MOVEM 4,FPPN
CAIN 6,2 ;SKIP UNLESS INPUT FILE.
MOVEM 4,SAVPPN ;SAVE PPN FOR EDITOR. TVR 10/72
ITS,< DSKPPN 4, ;SET SNAME FOR LOOKUP >
IFN STANSW,< MOVSI 1,400000 ;ASSUME DMP NEVER.
CAIE 6,4 > ;SKIP IF IO CODE 4 - LIST FILE.
MOVEI 1,0 ;NOT A LIST FILE.
MOVEM 1,FEXT+1 ;STANSW: LIST FILE PROT=400, DUMP NEVER.
MOVE 1,TBL1-2(6) ;GET BUFFER INFO
MOVEM 1,INIT2 ;STORE FOR INIT
INIT1: INIT 0,@TBL3-2(6) ;CLOBBER CHANNEL IN INIT
^NAM: 0 ;DEVICE NAME HERE
INIT2: 0 ;AND BUFFER HEADERS HERE
JRST ERR1 ;DEVICE NOT AVAILABLE
INIT3: MOVE 1,[FNAM,,LNAM]
BLT 1,LNAM+3 ;SAVE LAST FILE NAME ATTEMPTED
XCT TBL2-2(6) ;LOOKUP OR ENTER
JRST INIT4 ;LOSE
CAIE 6,2 ;INPUT FILE?
JRST @INITIT ;NO. RETURN NOW.
;SET UP FILNM FOR ERROR TYPEOUT
ITS,< MOVE 6,[2,,SRCSTS]
.RCHST 6,
MOVE 5,[440600,,SRCSTS+1] ;FILE NAME >;ITS
NOITS,< SKIPN 5,LNAM ;FILE NAME
SETZM LNAM+1 ;NULL FILE IMPLIES NULL EXT
SKIPN 5
MOVE 5,LFDEV ;USE DEVICE NAME IF NULL FILE>;NOITS
IFE STANSW,< NOTNX,< NOITS,<
SETZM INTTYF ;ASSUME INPUT DEVICE IS NOT TTY
MOVEI 6,2 ;CHANNEL NUMBER
DEVCHR 6, ;GET DEVICE CHARACTERISTICS
TLNE 6,10
SETOM INTTYF ;THIS IS A TTY. SEE INP.
>;NOITS >;NOTNX >;IFE STANSW
SETZM FILNM
SETZM FILNM+1
SETZM FILNM+2
SETZM FILNM+3
SETZM FILNM+4 ;6 DEV, :, 6 NAME, . 6 EXT, NULL
MOVE 6,[440700,,FILNM]
MOVEI 3," "
IDPB 3,6
JSR NOLS3 ;CONVERT SIXBIT TO ASCII
ITS,< MOVEI 3," " > ;A MATTER OF TASTE
NOITS,< HLLZS 3,LNAM+1 ;LEFT HALF ONLY
MOVEI 5,":" ;(POSSIBLE DEVICE NAME)
JUMPE 3,[SKIPN LNAM ;WAS THERE A FILE NAME?
IDPB 5,6 ;SEND : FOR DEVICE
JRST NOLS4] ;DON'T TYPE A BLANK EXTENSION
MOVE 5,LNAM+1 ;EXTENSION
MOVEI 3,"." >
IDPB 3,6 ;SPACE OR POINT BETWEEN FILE NAMES
JSR NOLS3
MOVEI 3,0
NOLS4: IDPB 3,6 ;NULL MARKS END OF FILE NAME
SKIPE 3,FILSTC ;GET FILE-STACK DEPTH
OUTSTR [ASCIZ/ /] ;TYPE 2 LEADING SPACES FOR EACH LEVEL DEEP
SOJG 3,.-1
OUTSTR FILNM
OUTSTR TTCRLF
JRST @INITIT ;RETURN
ITS,<
NOLS3: 0
MOVEI 4,6
ILDB 3,5
ADDI 3," " ;CONVERT TO ASCII
IDPB 3,6
SOJG 4,.-3
JRST @NOLS3
>;ITS
NOITS,<
NOLS3: 0
NOLS3A: MOVEI 4,0
LSHC 4,6
ADDI 4," "
IDPB 4,6
JUMPN 5,NOLS3A
JRST @NOLS3
>;NOITS
INIT4: CAIE 6,2 ;INPUT FILE?
JRST ERR2 ;NO. WE CAN'T WIN
ITS,< JUMPN 3,ERR2 ;LOSE IF EXPLICIT EXT
MOVSI 3,360000 > ;GREATER THAN
NOITS,< TRNN 3,-1 ;SKIP IF THIS WAS DEFAULT EXT
JRST ERR2 ;NO. USER SPECIFIED EXT.
MOVEI 3,0 > ;TRY NULL EXTENSION
MOVEM 3,FEXT
JRST .+2 ;TRY AGAIN
^REENT: MOVEM 1,INITIT ;JSP HERE TO DO ENTER OVER AFTER UTPCLR
MOVEM 4,FPPN
JRST INIT3
TBL3: 1 ;SOURCE MODE 1
14 ;BINARY MODE 14
1 ;LISTING MODE 1
16 ;UNKNOWN
1 ;COMMANDS MODE 1
TBL1: IDB
ODB,,0
LOB,,0
0
CTLBUF
TBL2: LOOKUP 2,FNAM
ENTER 3,FNAM
ENTER 4,FNAM
LOOKUP 5,FNAM
LOOKUP 6,FNAM
^^FNAM: 0
FEXT: 0
0
^FPPN: 0
^^LFDEV: 0 ;LAST DEVICE ATTEMPTED
^^LNAM: BLOCK 4 ;LAST NAME ATTEMPTED (FOR LOOKUP)
>;NOTNX
TNX,<
;INITIT -- GTJFN AND OPEN FILE
;GTNAM SHOULD BE SET UP ON ENTRY. PNTR TO STRING END IN 1, TERMINATOR IN 2.
;DEFAULT EXT STRING PTR IN 3, 'CHANNEL' IN 6 AS BEFORE.
^^INITIT: 0
MOVE 5,2 ;SAVE TERMINATOR
MOVEM 3,GTEXT ;SAVE EXT FOR GTJFN
SETZ 3,
IDPB 3,1 ;TERMINAL NULL
MOVEI 1,GTTBL ;PARAM BLOCK FOR GTJFN
HRROI 2,GTNAM ;FILE NAME STRING
MOVE 3,TBL3-2(6) ;GTJFN BITS FOR CHAN
MOVEM 3,GTTBL
GTJFN
JRST ERR1 ;CAN'T FOR ONE REASON OR ANOTHER
MOVEM 1,JFNTBL-2(6) ;SAVE JFN
MOVE 2,TBL2-2(6) ;OPENF FLAGS FOR CHAN
OPENF
JRST ERR2 ;CAN'T OPEN
DVCHR
SETZ 1,
LDB 2,DEVPTR ;PICK UP DEVICE TYPE
SKIPN 2
TLO 1,400000 ;IF DISK
CAIN 2,12 ;TTY:?
TLO 1,200000 ;YEP
HLLM 1,JFNTBL-2(6) ;SAVE FLAGS
CAIE 6,2
JRST INITX1 ;NOT SOURCE FILE
JSR XJFNS
INITX: MOVE 2,5 ;RESTORE TERMINATOR
JRST @INITIT ;EXIT
INITX1: CAIE 6,6 ;IF INDIRECT
SKIPL 1,JFNTBL-2(6)
JRST INITX ;IF NOT PMAPPABLE
HRLI 1,11 ;FDBSIZ,,JFN
HRLZI 2,007700 ;BYTE SIZE BITS
LDB 3,SZPTR ;LOAD UP CORRECT SIZE
LSH 3,=24 ;JUSTIFY
CHFDB ;SET SIZE FOR PEOPLE WHO DON'T PMAP
JRST INITX
SZPTR: POINT 6,TBL2-2(6),5 ;POINTER TO BYTE SIZE FIELD IN OPENF PARAM
DEVPTR: POINT 9,2,17 ;POINTER TO DEVICE TYPE FIELD IN DVCHR RET
;GTJFN PARAMETER BLOCK
^^GTTBL: 0 ;FLAG,,DEF VER
XWD 377777,377777 ;NO JFNS
^^GTDEV:0 ;DEF DEV
0 ;DEF DIR
0 ;DEF NAME
^^GTEXT:0 ;DEF EXT
0 ;PROT
0 ;ACCT
0 ;REQ JFN
^^GTNAM: BLOCK =26 ;FILE NAME STRING
;JFN TABLE
;B0 SET IF FILE IS PMAPPABLE
^^JFNTBL: BLOCK 5
;OPENF FLAG BITS
TBL2: XWD 440000,200000 ;INPUT: 36 BIT, READ ONLY
XWD 440000,300000 ;BIN: 36 BIT, READ/WRITE...
XWD 070000,300000 ;LIST: 7 BIT, READ/WRITE...
0 ;UNUSED (I HOPE)
XWD 440000,200000 ;IND: 36 BIT, READ ONLY
;GTJFN FLAG BITS
TBL3: XWD 100000,0 ;INPUT: OLD FILE
XWD 400000,0 ;BIT: FOR OUTPUT
XWD 400000,0 ;LIST: FOR OUTPUT
0 ;UNUSED
XWD 100000,0 ;IND: OLD FILE
MAKSIX: 0
MOVEI 2,0
MOVEI 3,6
MAKSX1: ILDB 4,1
JUMPE 4,MAKSX2 ;STOP AT NULL
CAIL 4," " ;FLUSH IF OUT OF RANGE
CAIL 4,140 ;THERE SHOULD BE NO LOWERCASE
JRST MAKSX3
LSH 2,6
IORI 2,-" "(4)
MAKSX3: SOJG 3,MAKSX1 ;LOOP UNTIL DONE
MAKSX2: JUMPE 2,@MAKSIX
TLNE 2,770000
JRST @MAKSIX
LSH 2,6
JRST .-3
^^XJFNS:0 ;CALLED FROM .INSRT TOO
HRRZ 2,JFNTBL ;JFN AGAIN
HRROI 1,FILNM1 ;GET THE FIRST FILE NAME
MOVSI 3,001000 ;FILE NAME ONLY. NO PUNCT.
JFNS
MOVE 1,[POINT 7,FILNM1]
JSR MAKSIX ;CONVERT NAME TO SIXBIT
MOVEM 2,FILNM1 ;SAVE FOR .FNAM1 FUNCTION
HRROI 1,FILNM2
HRRZ 2,JFNTBL
MOVSI 3,000100 ;EXTENSION ONLY. NO PUNCT.
JFNS
MOVE 1,[POINT 7,FILNM2]
JSR MAKSIX
MOVEM 2,FILNM2
HRRZ 2,JFNTBL ;JFN
HRROI 1,FILNM ;FOR TITLES
MOVE 3,[XWD 211110,1] ;DEF DEV, FRC DIR, NAME, EXT, VER W/PUNC
JFNS
SKIPE 3,FILSTC
OUTSTR [ASCIZ/ /] ;2 SP FOR EACH NESTING LEVEL
SOJG 3,.-1
HRROI 1,FILNM
PSOUT ;AND FILE NAME
SETZ 3, ;END WITH A WORD OF NULLS
REPEAT 5,<IDPB 3,1>
SUBI 1,FILNM
MOVNS 1
HRLM 1,FILCNT
OUTSTR TTCRLF ;CRLF FOR USER'S TERMINAL
JRST @XJFNS
>;TNX
BEND INITIT
^RELFIL:BLOCK 5 ;SAVE REL FILE NAME FOR RENAME AT END
;PROCESS ENTIRE COMMAND LINE (CO-ROUTINE) DOES @ AND ! COMMANDS
^INITL: 0
SETZM RPGNEED ;CLEAR EOF HACK FOR COMMAND FILE
NOTNX,<
MOVEI 1,0
NOITS,< HRLOI 3,'REL'> ;NOITS, -1 RH FLAGS DEFAULT EXTENSION
ITS,< SETZM LIMBO
MOVSI 3,'REL' >;ITS
SETZB 5,4 ;NO FILE NAME, PPN
JSR GETFIL
JRST NOBIN ;NO FILE THERE
CAIN 2,"!" ;CHECK FOR LOAD COMMAND
JRST DOLOD
JUMPN 1,.+2 ;NULL DEVICE?
MOVSI 1,'DSK' ;YES. ASSUME DSK
CAIN 2,"@"
JRST DOAT ;PROCESS COMMAND FILE.
MOVEM 5,RELFIL ;FILE NAME
NOITS,< HLLZM 3,RELFIL+1 > ;STORE REL FILE EXT. (NOT RIGHT HALF BITS)
ITS,< MOVEM 3,RELFIL+1 > ;STORE THE WHOLE WORD FOR EXT
MOVEM 1,RELFIL+4 ;DEVICE NAME
TRO BDEV ;INDICATE WE HAVE A BINARY DEVICE
MOVEI 6,3 ;DEVICE 3 FOR BINARY
ITS,< CAIE 2,15
CAIN 2,12
SKIPA 2,[12] ;PRECISELY <FILE SPEC>CRLF. SET DELIM TO LF
JRST INITL1
MOVEM 2,RPGNEED
SETZM MOINSW
MOVSI 3,'REL'
EXCH 3,RELFIL+1
CAMN 3,RELFIL+1
MOVEI 3,0
MOVEM 3,SOUT ;SAVE SOURCE FILE EXT
MOVSI 3,'REL' ;USE DEFAULT BINARY FILE EXT
JSR INITIT
OUTBUF 3,2
MOVE 3,SOUT ;EXTENSION
MOVE 1,RELFIL+4 ;DEVICE
MOVE 5,RELFIL ;FILE NAME
JRST NOLS3
>;ITS
INITL1: JSR INITIT
IFE STANSW,< OUTBUF 3,2 >;NO STANFORD
IFN STANSW,< OUTBUF 3,=10 >;STANFORD
JSR SWITCH ;GO SEE IF WE HAVE A SWITCH TO PROCESS
NOBIN: CAIE 2,"," ;DOES HE WANT LISTING
JRST NOLST ;APPEARANTLY NOT
MOVSI 1,'DSK' ;ASSUME DSK OUTPUT
SETZB 5,4 ;NO FILE, NO PPN
IFN STANSW,<MOVSI 3,'LST'> ;ASSUME LST
IFE STANSW,<MOVSI 3,'CRF'> ;FOR CREF.
JSR GETFIL
JRST NOLST ;MUST BE ,_
MOVEI 6,4 ;SET IO CHANNEL FOR LISTING
JSR INITIT
TRO LDEV
SETOM LISTSW
IFE STANSW,< OUTBUF 4,5 >;NOT STANFORD
IFN STANSW,< OUTBUF 4,=10 >;STANFORD
JSR SWITCH
NOLST: CAIE 2,"_"
CAIN 2,"=" ;ALTERNATIVE FOR RPG HACKERS
JRST .+2
JRST ERR3
SETZM MOINSW ;HAVEN'T SEEN ANY INPUT FILES ON THIS LINE
MOVSI 1,'DSK' ;DEFAULT DEVICE
NOLS2: MOVEI 5,12
MOVEM 5,RPGNEED ;SET EOF HACK. IN CASE OF EARLY EOF ON COMMAND FILE
SETZB 4,5 ;NO PPN, NO FILE.
NOITS,< HRLOI 3,'FAI' > ;ASSUME DEFAULT EXT
ITS,< MOVEI 3,0 > ;ASSUME NO EXTENSION
JSR GETFIL
JRST [CAIN 2,12 ;FILE SPEC WAS EMPTY.
SKIPN MOINSW ;HAVE WE SEEN A FILE ON THIS LINE?
JRST ERR3
SKIPN RPGSW ;RPG MODE?
OUTSTR [BYTE(7)15,12,"_"] ;PROMPT IF WE'RE TAKING TTY COMMANDS
SETZM MOINSW ;THIS IS TO CATCH CRLF AS ILLEGAL
JRST NOLS2] ;SAW ...FILE,<CRLF> (OR ..._<CRLF>)
NOLS3: MOVEM 1,SAVDEV# ;SAVE FOR NEXT TIME
MOVEI 6,2 ;DEVICE 2 = INPUT FILE.
JSR INITIT
SETZM IRECN ;INITIALIZE RECORD NUMBER FOR RANDOM ACCESS IO
MOVEI 12,IBUFR1 ;ADDRESS OF THE FIRST BUFFER
TLO 12,400000
MOVEM 12,IDB ;SET UP BUFFER
JSR SWITCH ;SEE IF THERE ARE ANY SWITCHES
SETZM MOINSW#
NOITS,< CAIN 2,";" ;ALLOW SEMICOLON TO EQUAL COMMA (RPG HACKERS)
SETOM MOINSW >
CAIE 2,"+" ;ALLOW + TO DENOTE MORE INPUT (RPG HACKERS)
CAIN 2,","
SETOM MOINSW ;SAY HE HAS MORE TO COME
>;NOTNX
TNX,<
HRROI 3,[ASCIZ /REL/] ;DEF EXT FOR BIN FILE
JSR TGETF ;GET TENEX FILE NAME
JRST NOBIN ;NO FILE FOUND
CAIN 2,"!"
JRST DOLOD ;WANTS .SAV FILE RUN
CAIN 2,"@"
JRST DOAT ;INDIRECT COMMAND FILE
TRO BDEV ;GOT A BIN FILE
MOVEI 6,3 ;GOES ON CHANNEL 3
JSR INITIT ;GTJFN,OPENF
SETOM ODB ;IN CASE IT IS PMAPABLE...
SETZM ODB+2 ;CLEAR COUNTER
JSR SWITCH ;LOOK FOR SWITCHES
NOBIN: CAIE 2,","
JRST NOLST ;BIN_
HRROI 3,[ASCIZ /LST/] ;DEF LIST EXTENSION
JSR TGETF ;GET TENEX FILE NAME
JRST NOLST ;BIN,_
MOVEI 6,4 ;CHANNEL FOR FOR LIST FILE
JSR INITIT ;GTJFN,OPENF
SETOM LOB ;IN CASE IT IS PMAPABLE, FIX IT SO WE GET 0 FIRST
SETZM LOB+2 ;CLEAR COUNTER!!
TRO LDEV
SETOM LISTSW
JSR SWITCH ;LOOK FOR SWITCHES
NOLST: CAIE 2,"_"
CAIN 2,"="
JRST .+2
JRST ERR3 ;NO BACK ARROW
SETZM MOINSW#
NOLS2: MOVEI 5,12 ;EOF JOINS HERE...
MOVEM 5,RPGNEED ;SUPER DUPER HACK
HRROI 3,[ASCIZ /FAI/] ;DEF SOURCE EXT
JSR TGETF ;GET TENEX FILE NAME
JRST [CAIN 2,12
SKIPN MOINSW
JRST ERR3
SKIPN RPGSW
OUTSTR [ASCIZ /
_/] ;PROMPT INTERACTIVE USER.
SETZM MOINSW
JRST NOLS2]
MOVEI 6,2 ;SOURCE ON CHAN 2
JSR INITIT ;GTJFN, OPENF
JSR SWITCH ;LOOK FOR SWITCHES
SETZM MOINSW
CAIN 2,","
SETOM MOINSW ;IF MORE FILES ON THIS LINE
SETOM IRECN ;FIRST INCR WILL MAKE THIS ZERO
MOVEI 1,400000 ;THIS FORK
DIR ;DISABLE INTERRUPTS
TRNE LDEV
SKIPGE JFNTBL+2
JRST .+2 ;NO LIST OR PMAPABLE
MOVE 3,LSTBF ;GUARANTEE THAT IT IS MAPPED
TRNE BDEV
SKIPGE JFNTBL+1
JRST .+2 ;NO BIN OR PMAPABLE
MOVE 3,BINBF ;GUARANTEE THAT IT IS MAPPED
SKIPL JFNTBL
MOVE 3,SRCBF ;GUARANTEE THAT IT IS MAPPED
MOVE 3,TRM ;ALWAYS HIT TERMINATOR PAGE...
CIS ;IN CASE THERE WERE ANY PAGE FAULTS
EIR ;TURN INTERRUPTS ON AGAIN
>;TNX
AOS INITL ;FORM SKIP RETURN
MOVEM 17,INSV+17 ;SAVE ACS FOR CO-ROUTINE CALL FROM EOF
MOVEI 17,INSV
BLT 17,INSV+16
MOVE 17,INSV+17
JRST @INITL ;RETURN TO CALLER.
INSV: BLOCK 20 ;SAVE AC'S FOR CO-ROUTINE CALL FROM EOF
^^TSV: BLOCK 20 ;SAVE MAIN AC'S FROM EOF DURING CO-ROUTINE CALL
^EOF: 0 ;HERE AT EOF ON INPUT FILE
SKIPN MOINSW ;ARE THERE MORE INPUT FIELDS?
JRST FAT ;NO. LOSE BIG
NOTNX,< RELEAS 2,> ;YES. RELEASE INPUT FILE
MOVEM 17,TSV+17 ;SAVE OUR AC'S
MOVEI 17,TSV
BLT 17,TSV+16
TNX,< JSR CLSSRC>
MOVEI 17,EOFRT ;SETUP RETURN ADDRESS FROM INITL
MOVEM 17,INITL
MOVSI 17,INSV ;RESTORE AC'S THAT INITL SAVED
BLT 17,17
ITS,< MOVE 17,TPDP > ;I WANT A PUSH DOWN POINTER!
TNX,< MOVE 17,TPDP > ;INITL DOES UUOS, NEEDS STACK
NOTNX,< MOVE 1,SAVDEV> ;GET THE LAST DEVIC NAME THAT WE WERE USING
JRST NOLS2 ;JUMP INTO INITL
EOFRT: JRST FAT ;RETURN FROM INITL - FAILURE
MOVSI 17,TSV ;SUCCESS. RESTORE MAIN AC'S
BLT 17,17
JRST @EOF ;RETURN TO CALLER. WE HAVE MORE FILE TO MUNCH
NOTNX,<
SWPR: BLOCK 6 ;PUT PARAMS FOR SWAP HERE
^^SAVPPN: 0
DOLOD: JUMPN 1,.+2 ;CHANGE DEFAULT TO SYS
MOVSI 1,'SYS'
TRNE 3,-1 ;RH OF 3 WILL BE NON-ZERO IF EXPLICT EXTENSION SEEN
MOVSI 3,0 ;DEFAULT TO MONITOR SUPPLIED .DMP (OR .SAV, ETC.)
MOVEM 1,SWPR ;DEVICE
MOVEM 5,SWPR+1 ;FILE NAME
MOVEM 3,SWPR+2 ;EXTENSION
MOVEM 4,SWPR+4 ;PPN
MOVEI 1,SWPR
SKIPGE RPGSW
HRLI 1,1 ;START IN RPG MODE IF WE WERE STARTED IN RPG MODE
JSR DELRPG
RESET
MOVE 0,.JBFF
CORE 0, ;SHRINK BECAUSE TOPS-10 IS STUPID
JFCL
RUN 1,
JRST 4, ;(AT STANFORD, YOU CAN'T GET HERE.)
DOAT: MOVEI 6,6 ;HERE WHEN FILE@ COMMAND IS SEEN.
ITS,< CAMN 3,['REL ']
MOVSI 3,'CMD' ;CHANGE DEFAULT EXTENSION > ;ITS
NOITS,< TLZ 3,(3)> ;IF NO EXT GIVEN, RIGHT HALF IS -1. MAKE NULL
MOVEI 6,6 ;DEVICE 6
JSR INITIT ;GO GET IT SET UP
PUSHJ P,RPGS1 ;NOW FAKE READING THE RPG FILE.
JRST RPGGO ;SET RETURN FROM RPGS1
>;NOTNX
IFN TENEX!ITSSW,<
TPDP: -20,,TPDL-1
TPDL: BLOCK 20
>
TNX,<
STRTCD:
PHASE 5 ;TO EXEC IN ACS
NOT20,<
HRR 2,3 ;400000,,PG ;5
PMAP ;OUT OF CORE ;6
AOBJN 3,.-2 ;IF MORE PAGES ;7
>;NOT20
T20,<
PMAP
JFCL
JFCL
>;T20
MOVE 1,4 ;400000,,JFN ;10
GET ;LOAD FORK UP ;11
MOVEI 1,400000 ;THIS FORK ;12
GEVEC ;13
HRRZ 1,.JBSA ;ASSUME 10/50 FORMAT ;14
TLNN 2,777000 ;15
HRRZ 1,2 ;TENEX FORMAT ;16
XXSTRT::JRST (1) ;START US UP ;17
;THIS GETS CLOBBERED TO JRST 1(1)
;FOR RPG MODE STARTUP
DEPHASE
LCD__.-STRTCD
DOLOD: SETZ 3,
IDPB 3,1 ;TERMINAL NULL ON FILE NAME
NOT20,< HRROI 3,[ASCIZ /SAV/] ;DEF RUN EXTENSION >;NOT20
T20,< HRROI 3,[ASCIZ /EXE/] ;DEF RUN EXTENSION >;T20
MOVEM 3,GTEXT
HRROI 3,[ASCIZ/SYS/]
MOVEM 3,GTDEV ;default device for run
JSR DELRPG ;DELETE RPG FILE, IF ANY.
MOVEI 1,GTTBL ;GTJFN PARAM BLOCK
HRROI 2,GTNAM ;FILE NAME STRING
MOVE 3,[XWD 100000,0];OLD FILE
MOVEM 3,GTTBL
GTJFN
JRST TNXERR ;LOSE BIG
HRLI 1,400000 ;THIS FORK
MOVE 4,1 ;400000,,JFN OF NEW FILE
MOVEI 1,400000 ;THIS FORK
SETO 2, ;ALL INTS
DIC ;OFF!!
SETO 1,
MOVE 2,[XWD STRTCD,5]
BLT 2,5+LCD-1 ;MOVE STARTUP CODE TO ACS
SKIPGE RPGSW ;IN RPG MODE?
HRRI XXSTRT,1 ;SET ENTRY OFFSET
NOT20,<
HRLZI 2,400000
MOVE 3,[XWD -777,1]
>;NOT20
T20,<
MOVE 2,[400000,,1] ;PROCESS HANDLE,,FIRST PAGE
MOVE 3,[400000,,777] ;PAGE COUNT
>;T20
JRST 5 ;LOAD ON TOP OF SELF AND START
^TNXERR:
MOVEI 1,101
HRLOI 2,400000 ;PROCESS HANDLE, MOST RECENT ERROR
MOVEI 3,0
ERSTR
JFCL
JFCL
HALTF
JRST .-1
DOAT: MOVEI 6,6 ;CHAN 6 FOR INDIRECT FILE
SETZ 3, ;NO DEF EXT
JSR INITIT ;GTJFN, OPENF
HLLOS RPGSW ;0,,-1 IS INDIRECT (I HOPE)
SETZM CTLBUF+2 ;CLEAR COUNTER
MOVEI 1,400000 ;THIS FORK
DIR ;KILL INTERRUPTS
MOVE 3,INDBF ;MAP BUFFER PAGE
CIS ;CLEAR INTERRUPTS
EIR ;ENABLE INTERRUPTS
JRST RPGGO ;OFF WE GO...
>;TNX
ERR3: OUTSTR [ASCIZ /INPUT SYNTAX ERROR/]
ERR: OUTSTR TTCRLF
MOVEI 4,0
SKIPN RPGSW ;IF IN RPG MODE, SCAN TO END OF LINE
JRST @INITL
ERRL: CAIN 2,12
JRST @INITL
JSR IN
JRST ERRL
NOTNX,<
ERR1: OUTSTR [ASCIZ /DEVICE NOT AVAILABLE: /]
MOVE 7,NAM
ERRM: PUSHJ P,MS6
OUTSTR TTCRLF
MOVEI 4,0
JRST @INITL
ERR2: CAIE 6,3 ;SKIP IF ENTER FAILURE ON BINARY
CAIN 6,4 ;SKIP IF NOT ENTER FAILURE ON LIST
SKIPA 6,[[ASCIZ /ENTER FAILED /]] ;ENTER FAILURE
MOVEI 6,[ASCIZ /FILE NOT FOUND /] ;LOOKUP FAILURE
OUTSTR (6)
MOVE 7,FNAM
PUSHJ P,MS6
OUTCHR ["."]
ITS,< MOVE 7,FNAM+1>
NOITS,< HLLZ 7,FNAM+1>
JRST ERRM
MS6: MOVEI 6,0 ;PRINT SIXBIT CONTENTS OF 7
JUMPE 7,CPOPJ
LSHC 6,6
ADDI 6," "
OUTCHR 6
JRST MS6
>;NOTNX
TNX,<
ERR1: OUTSTR [ASCIZ /Can't get JFN: /]
OUTSTR GTNAM
ERR1A: OUTSTR TTCRLF
MOVE 2,5 ;RESTORE TERMINATOR
JRST @INITL ;FAIL
ERR2: OUTSTR [ASCIZ /Can't open file: /]
MOVEI 1,101 ;PRIMARY OUTPUT
HRRZ 2,JFNTBL-2(6) ;JFN
MOVE 3,[XWD 211110,1] ;DEF DEV,FRC DIR,NAM,EXT,VER W/PUNC
JFNS ;SPIT OUT OFFENDING FILE NAME
MOVE 1,2
RLJFN ;RELEASE JFN
JFCL
JRST ERR1A
>;TNX
BEGIN SWITCH
^SWITCH:0
CAIE 2,"/"
CAIN 2,"("
JRST .+2
JRST @SWITCH ;WE'RE NOT INTERESTED IN THIS CHARACTER.
SETZM LPARF# ;NOT IN PARENTHESES SWITCHES
CAIN 2,"("
SETOM LPARF ;MARK PARENS TYPE SWITCH
SW0: MOVEI 10,0 ;NUMBER COUNT
SW1: JSR IN ;GET A SWITCH
CAIN 2,")" ;SEE IF END
JRST RPAR ;YES
CAIG 2,"9"
CAIGE 2,"0"
JRST SW1A
IMULI 10,=10 ;ACCUMULATE NUUMBERS
ADDI 10,-"0"(2)
JRST SW1
SW1A: CAIL 2,140 ;CHANGE LOWER TO UPPER
SUBI 2,40
CAIL 2,"A"
CAILE 2,"Z"
JRST ERR4 ;OUT FOR BOUNDS - ILLEGAL
HLRZ 7,TBL1-"A"(2) ;GET INSTRUCTION
CAIN 7,(<JUMPA>) ;IS THIS ILLEGAL ON INPUT?
CAIE 6,2 ;YES. SKIP IF THIS INPUT TERM
JRST OK ;SWITCH IS OK HERE
JRST ERR5 ;ILLEGAL ON INPUT TERM
OK: XCT TBL1-"A"(2) ;PERFORM SWITCH FUNCTION
SW4: SKIPE LPARF ;IN PARENS?
JRST SW0 ;YES - LOOK FOR MORE
SW3: JSR IN ;GET ANOTHER CHR
JRST SWITCH+1
RPAR: SKIPE LPARF ;IN PARENS?
JRST SW3 ;YES, EXIT TIME
JRST ERR3 ;NO, LOSAGE
ERR4: SKIPA 6,[[ASCIZ /UNKNOWN SWITCH: /]]
ERR5: MOVEI 6,[ASCIZ /SWITCH ILLEGAL ON INPUT TERM: /]
OUTSTR (6)
OUTCHR 2
JRST ERR
;IF THE INSTRUCTION IS A JUMPA, IT IS ILLEGAL ON THE INPUT TERM
IFE SYMDMP,<SYMWRT__ERR4>
TBL1: NOTNX,<JRST ADV;> JRST ERR4 ;A - ADVANCE
NOTNX,<JRST BSP;> JRST ERR4 ;B - BACKSPACE
JUMPA CREFST ;C - CREF (ILLEGAL ON INPUT TERM)
JRST ERR4 ;D - ILLEGAL
JUMPA SLSHE ;E - SET MAIN PDL LENGTH (ILLEGAL ON INPUT)
SETZM ERSTSW ;F - DON'T STOP AT ERRORS
JRST ERR4 ;G - ILLEGAL
JRST ERR4 ;H - ILLEGAL
SETOM XL1IG ;I - IGNORE XLIST1
JRST ONCRF ;J - TURN ON CREF FOR THIS (INPUT) TERM
SETZM XCRFSW ;K - TURN OFF CREF FOR THIS (INPUT) TERM
SETOM NOLTSW ;L - DON'T LIST LITERAL VALUES WITH TEXT
JRST ERR4 ;M - ILLEGAL
SETOM TTYERR ;N - DON'T LIST ERRORS ON TTY
SETOM FUNSUP ;O - OMIT .FUN FILE OUTPUT
JUMPA SLSHP ;P - SET SIZE OF PDL (ILLEGAL ON INPUT TERM)
JRST ERR4 ;Q - ILLEGAL
SETOM ERSTSW ;R - STOP ON ERRORS
SETOM SYMOUT ;S - LIST SYMBOL TABLE
NOTNX,<JRST LND;> JRST ERR4 ;T - ADVANCE TO END OF TAPE
SETOM UNDLNS ;U - UNDERLINE MACRO EXPANSION
JUMPA PAGER ;V - SET PAGE LENGTH FOR LISTING
NOTNX,<JRST WND;> JRST ERR4 ;W - REWIND TAPE
SETOM NOEXP ;X - DON'T LIST MACRO EXPANSIONS
JRST SYMWRT ;Y - FOR REG'S SYMBOL TABLE OUTPUT
JUMPA ZER ;Z - ZERO DECTAPE DIRECTORY
;THE MAGTAPE SWITCHES
NOTNX,<
ZER: DPB 6,[POINT 4,ZERA,12] ;/Z SWITCH
DPB 6,[POINT 4,ZERA+1,12]
ZERA: UTPCLR
CLOSE
JSP 1,REENT ;GO DO ENTER AGAIN
JRST SW4
DEFINE MAG (A,B)
< DPB 6,[POINT 4,.+1,12]
MTAPE A
SOJG 10,.-1 ;DO IT A NUMBER OF TIMES
IFN B,< XCT .-2
DPB 6,[POINT 4,.+3,12]
DPB 6,[POINT 4,.+3,12]
DPB 6,[POINT 4,.+3,12]
MTAPE 0
STATO 1B24
MTAPE 16>
JRST SW4
>
WND: MAG 1,0
ADV: MAG 16,0
BSP: MAG 17,1
LND: MAG 10,0
>;NOTNX
TNX,<
ZER: HRRZ 1,JFNTBL-2(6) ;JFN
DVCHR ;CONVERT TO DEVICE
INIDR ;GOD HELP YOU IF THIS IS NOT DTAN:
JRST [OUTSTR [ASCIZ /Can't clear directory: /]
MOVEI 1,101 ;PRIMARY OUTPUT
HRRZ 2,JFNTBL-2(6) ;JFN
MOVE 3,[XWD 111110,1];FRC DEV, DIR, NAM, EXT, VER W/PUNC
JFNS ;SPIT IT OUT
MOVE 1,2
CLOSF ;HAVENT MAPPED ANYTHING ANYHOW
JFCL
JRST ERR]
JRST SW4
;NO HOPE OF MAGTAPES EVER WORKING ANYHOW...
>;TNX
CREFST: SETOM CREFSW
SETOM XCRFSW
MOVEI 10,LINLEN-8
MOVEM 10,CHRPL ;SET CHRPL SO CREF LISTINGS WON'T OVERFLOW - JHS
JRST SW4
ONCRF: SKIPE CREFSW
SETOM XCRFSW
JRST SW4
SLSHP: SKIPN 10
MOVEI 10,1
ADDM 10,PSWIT
JRST SW4
SLSHE: SKIPN 10
MOVEI 10,1
ADDM 10,ESWIT
JRST SW4
PAGER: CAIL 10,20
MOVEM 10,PAGSIZ ;SET PAGE SIZE FROM V SWITCH
JRST SW4
BEND SWITCH
; HERE FOR FATAL ERROR. END OF FILE AND NO END STATEMENT
FAT:
MOVEI 3,LITMS
SKIPE LITPG
PUSHJ P,FMES ;IN LITERAL.
MOVEI 3,TXTMS
SKIPE TXTPG
PUSHJ P,FMES ;IN ASCII, SIXBIT
MOVEI 3,SARMS
SKIPE SARGPG
PUSHJ P,FMES ;MACRO ARGUMENT SCAN
MOVEI 3,REPMS
SKIPE REP0PG
PUSHJ P,FMES ;REPEAT 0, CONDITIONAL, OR COMMENT
MOVEI 3,TXTIMS
SKIPE TXTIPG ;FOR OR DEFINE?
PUSHJ P,FMES
FATAL [ASCIZ /FATAL END OF FILE & NO END STMT/] ;COUP DE GRAS
;FMES IS ALSO CALLED BY PSLIT TO HELP POOR USERS DETECT TROUBLE SOONER
^FMES: MOVE 2,[ASCII / /] ;5 BLANKS
SKIPG 1,@-1(3) ;SKIP IF THERE'S AN SOS LINE NUMBER
MOVEM 2,@-1(3) ;STORE BLANKS INTO LINE NUMBER WORD
JUMPGE 1,FMES2 ;JUMP IF THERE WAS AN SOS NUMBER OR EMPTY
MOVEI 1,1(1) ;LINE NUMBER CAME FROM INLINE.
MOVSI 4,440700
HRRI 4,@-1(3) ;MAKE POINTER TO THE LINE NUMBER TEXT WORD
PUSHJ P,RNUM ;CONVERT TO TEXT.
FMES2: MOVE 1,-2(3) ;GET PAGE NUMBER
MOVE 4,-1(3) ;GET ADDRESS OF LINE NUMBER TEXT
ADDI 4,2 ;ADVANCE PAST THE TEXT OF " PAGE "
HRLI 4,(<POINT 7,0,6>) ;POINTER TO TRAILING BLANK OF " PAGE "
PUSHJ P,RNUM ;CONVERT PAGE NUMBER TO PAGE NUMBER.
NOTNX,<
MOVE 1,[POINT 7,-5(3)] ;POINTER TO THE FILE NAME (LEADING SPACE)
ILDB 2,1 ;READ A BYTE... APPEND FILE NAME TO END OF
IDPB 2,4 ;STUFF A BYTE ... ERROR MESSAGE
JUMPN 2,.-2 ;LOOP. END ON NULL
>;NOTNX
TNX,<
MOVE 1,4 ;CORRECT BYTE POINTER
HRRZ 2,-3(3) ;JFN
MOVE 4,3 ;SAVE ADDR
MOVE 3,[XWD 211110,1] ;DEF DEV, FRC DIR,NAM,EXT,VER W/PUNC
JFNS ;EXPAND IT
MOVE 3,4 ;RESTORE ADDR
>;TNX
ERROR (3) ;MAKE AN ERROR MESSAGE
POPJ P,
RNUM: IDIVI 1,=10
HRLM 2,(P)
SKIPE 1
PUSHJ P,RNUM
HLRZ 1,(P)
ADDI 1,"0"
IDPB 1,4
POPJ P,
^LITFIL:BLOCK NOTNX,<5;> 1 ;FILE NAME IN WHICH LITERAL OCCURS
^LITPG: 0 ;PAGE NUMBER
LITLIN ;POINTER TO LINE NUMBER
^LITMS: ASCII / LITERAL LINE / ;PRECISELY SOME MULTIPLE OF 5 CHARACTERS
^LITLIN:0 ;LINE NUMBER HERE BECOMES TEXT.
ASCII / PAGE / ;PRECISELY 6 CHARACTERS
BLOCK NOTNX,<4;> =27 ;TEXT OF PAGE NUMBER, FILE NAME COPIED HERE
^TXTFIL:BLOCK NOTNX,<5;> 1
^TXTPG: 0
TXLIN
TXTMS: ASCII /TEXT STATEMENT LINE /
^TXLIN: 0
ASCII / PAGE /
BLOCK NOTNX,<4;> =27
^SARFIL:BLOCK NOTNX,<5;> 1
^SARGPG:0
SARLN
SARMS: ASCII /REPEAT OR MACRO ARGUMENT LINE /
^SARLN: 0
ASCII / PAGE /
BLOCK NOTNX,<4;> =27
^REPFIL:BLOCK NOTNX,<5;> 1
^REP0PG:0
REPPG
REPMS: ASCII / REPEAT 0, CONDITIONAL, OR COMMENT LINE /
^REPPG: 0
ASCII / PAGE /
BLOCK NOTNX,<4;> =27
^TXTIFL:BLOCK NOTNX,<5;> 1
^TXTIPG:0
TXTIL
TXTIMS: ASCII / FOR OR DEFINE LINE /
^TXTIL: 0
ASCII / PAGE /
BLOCK NOTNX,<4;> =27
BEND INIT
BEGIN RPG SUBTTL INITIALIZATION OF PROGRAM
;SETRPG. CALLED WITH PUSHJ. SKIPS ON FAILURE OF ANY KIND
^SETRPG:
SKIPL RPGSW ;IN RPG MODE?
JRST CPOPJ1 ;NO. GIVE THE SKIP RETURN
NOTNX,<
IFN TMPCSW,< MOVSI 1,'FAI'
MOVEM 1,RPGNAM ;FILE NAME ARGUMENT FOR TMPCOR
MOVE 1,[-200,,RPGBUF-1]
MOVEM 1,RPGNAM+1 ;IOWD FOR READING TMPCOR FILE
MOVE 1,[POINT 7,RPGBUF]
MOVEM 1,CTLBUF+1 ;BYTE POINTER FOR IN
MOVE 1,[2,,RPGNAM] ;READ AND DELETE FILE.
TMPCOR 1,
JRST DSKRPG ;NOT IN SERVICE, OR NO FILE THERE
CAILE 1,200 ;MAKE SURE WE GOT IT ALL
JRST RPGIN5 ;WE LOSE.
SETZM RPGBUF(1) ;CLEAR FIRST FREE WORD. NEED A NULL AT END
IMULI 1,5 ;CNVT WC FROM TMPCOR TO CHAR CNT
ADDI 1,1 ;BE SURE TO INCLUDE THE EXTRA NULL
MOVEM 1,CTLBUF+2 ;SAVE BYTE COUNT
SETOM TMPCOR# ;FLAG WE ARE DOING TMPCORE
JRST RPGS5
>;IFN TMPCSW
DSKRPG: MOVSI 1,'FAI'
PJOB 2, ;JOB NUMBER
MOVEI 4,3 ;3 CHARACTERS OF JOB NUMBER
IDIVI 2,=10 ;3_LEAST SIGNIFICANT DIGIT
IORI 1,20(3) ;INCLUDE IN NAME
ROT 1,-6
SOJG 4,.-3 ;LOOP FOR 3 CHARACTERS
MOVSI 2,'TMP' ;FILE EXTENSION
MOVEM 1,RPGNAM ;STORE FILE NAME FOR RPG FILE
MOVEM 2,RPGNAM+1
SETZM RPGNAM+3 ;PPN
INIT 6,1
'DSK '
CTLBUF
JRST CPOPJ1 ;SEE US LOSE. (SKIP RETURN)
LOOKUP 6,RPGNAM ;NOW SEE IF FILE IS THERE
JRST CPOPJ1 ;LOSE (SKIP RETURN)
^RPGS1: MOVEI 1,RPGBUF ;THIS IS WHERE WE WANT OUT BUFFER PUT
EXCH 1,.JBFF ;(SAVE .JBFF)
INBUF 6,1 ;GET ONE BUFFER.
MOVEM 1,.JBFF ;(RESTORE OLD .JBFF)
>;NOTNX
TNX,<
T20,< ;RELEASE 3 of TOPS-20 simulates TMPCOR....
MOVE 1,[1,,400000] ;READ for this fork
MOVEI 2,RPGBUF ;ARG BLOCK
MOVEI 3,200 ;
PRARG
CAILE 3,200 ;number of words read
JRST [OUTSTR [asciz/Too many words in TMP file
/]
JRST CPOPJ1] ;return to tty scanner
JUMPE 3,DSKRPG ;the bus isn't running. take subway
MOVN 3,3
MOVSI 3,(3)
HRRI 3,RPGBUF
TMCLP1: HLRZ 1,(3)
CAIN 1,'FAI' ;is this the right place?
JRST TMCLP2 ;yes. stop the bus
AOBJN 3,TMCLP1
JRST DSKRPG ;transfer to the subway
TMCLP2: HRRZ 1,(3)
; SUBI 1,1 ;in rel 4, length is of data only
IMULI 1,5 ;CONVERT TO CHARACTER COUNT
MOVEM 1,CTLBUF+2 ;store count
HRLI 3,000700
MOVEM 3,CTLBUF+1 ;store byte pointer
SETOM TMPCOR#
JRST RPGS5
>;T20
DSKRPG: GJINF
MOVE 2,3 ;JOB NO TO 2
HRROI 1,RPGFIL
MOVE 3,[XWD 140003,=10] ;LEADING FILL ZEROES, BASE 10
NOUT
JRST CPOPJ1 ;HUH?
HRROI 2,RPGFI1
SETZ 3,
SOUT
IDPB 3,2 ;END WITH A NULL
HRLZI 1,100001 ;OLD FILE, SHORT FORM
HRROI 2,RPGFIL
GTJFN
JRST CPOPJ1 ;OOPS, NO FILE
MOVE 2,[XWD 440000,200000] ;36 BIT, READ ONLY
OPENF
JRST [RLJFN
JRST CPOPJ1
JRST CPOPJ1]
MOVEM 1,JFNTBL+4 ;SAVE JFN
SETZM CTLBUF+1 ;KILL COUNTER
MOVEI 1,400000 ;THIS FORK
DIR ;INT OFF
MOVE 3,INDBF ;MAP PAGE FOR BUFFER
CIS ;CLEAR AN MPV INTERRUPT
EIR ;REEANBLE INTS
>;TNX
RPGS5: HLLOS RPGSW ;(IF DOING @ FILE, SET RPGSW TO 0,,-1)
POPJ P, ;NON-SKIP FOR SUCCESS.
TNX,<
RPGFIL: ASCIZ /nnnFAI.TMP/ ;RPG FILE NAME
RPGFI1: ASCIZ /FAI.TMP/
>;TNX
^RPGRS: LDB 2,CTLBUF+1 ;SCAN TO END OF LINE
RPGRS2: CAIN 2,12
JRST RPGGO
JSR IN
JRST RPGRS2
;RPGIN IS CALLED FROM IN TO READ NEXT CHARACTER FROM RPG OR @ FILE.
;RETURNS CHARACTER IN 2.
; IF EOF OR ERROR ON RPG FILE, JUMPS TO RPGXIT
RPGIN3: AOS CTLBUF+1 ;HERE TO FLUSH SOS LINE NUMBER
MOVNI 2,5 ;GRONK BYTE POINTER.
ADDM 2,CTLBUF+2 ;ADJUST BYTE COUNT. GET NEXT CHARACTER
^RPGIN: SOSG CTLBUF+2 ;CALLED FROM IN
JRST RPGIN2 ;END OF BUFFER.
RPGIN1: IBP CTLBUF+1 ;ADVANCE BYTE POINTER
MOVE 2,@CTLBUF+1 ;GET THE CURRENT WORD
TRNE 2,1 ;SOS LINE NUMBER?
JRST RPGIN3 ;YES. FLUSH IT
LDB 2,CTLBUF+1
JUMPE 2,RPGIN ;IGNORE NULLS
CAIE 2,14 ;IGNORE FORM FEEDS
CAIN 2,15 ;IGNORE CR'S
JRST RPGIN
JRST @IN
RPGIN2: ;HERE AT END OF BUFFER.
T20,< SKIPE TMPCOR ;exit at eof on tmpcor
HALTF >;T20
NOTNX,<
IFN TMPCSW,< SKIPE TMPCOR ;AT EOB IN TMPCORE, EXIT
EXIT >;IFN TMPCSW
IN 6, ;READ NEXT
JRST RPGIN1 ;GOT SOME. DO IT.
STATZ 6,20000 ;EOF?
JRST RPGIN4 ;YES.
RPGIN5: OUTSTR [ASCIZ /ERROR READING COMMAND (OR RPG) FILE, OR TMPCOR TOO BIG/]
>;NOTNX
TNX,<
TSVAC <1,3>
HRRZ 1,JFNTBL-2+6 ;IND FILE JFN
MOVE 2,[POINT 36,INDBF]
HRROI 3,-1000 ;MAX NO BYTES
SIN
ADDI 3,1000 ;COMPUTE BYTES XFERED
IMULI 3,5 ;CONV TO 7 BIT BYTES
MOVEM 3,CTLBUF+2 ;SET COUNT
MOVE 2,[POINT 7,INDBF]
MOVEM 2,CTLBUF+1 ;AND POINTER
TRSTAC <1,3>
SKIPE CTLBUF+2
JRST RPGIN1 ;GOT SOME
JRST RPGIN4 ;EOF
>;TNX
RPGXIT: JSR DELRPG ;DELETE RPG FILE
SKIPGE RPGSW ;RPG MODE?
NOTNX,< EXIT> ;YES. DIE NOW.
TNX,< HALTF>
SETZM RPGSW
JRST STRT1
RPGIN4: MOVEI 2,0 ;PERHAPS HE NEEDS A TERMINATOR
EXCH 2,RPGNEED ;SEE IF HE DOES.
JUMPE 2,RPGXIT ;JUMP IF NO PROVIDED FOR HIM
DPB 2,CTLBUF+1 ;GOT ONE. PUT WHERE WE CAN SEE IT AGAIN.
JRST @IN ;GIVE IT TO HIM.
^DELRPG:0
NOTNX,<
IFN TMPCSW,< SKIPE TMPCOR ;DOING TMPCOR?
JRST @DELRPG ;YES. LET'S NOT DELETE RPG FILE >
SKIPGE RPGSW ;SKIP IF @ FILE, OR NOT RPG MODE
RENAME 6,ZEROS ;RENAME TO DELETE CURRENT FILE
JFCL ;IGNORE FAILURE FROM DELETE
RELEAS 6,
JRST @DELRPG
>;NOTNX
TNX,<
T20,< SKIPN TMPCOR ;NO DELETE IF TMPCOR >;T20
SKIPN RPGSW ;EITHER RPG OR INDIRECT MODE?
JRST @DELRPG ;NEITHER
HRRZ 1,JFNTBL-2+6
HRLI 1,400000 ;KEEP JFN THRU CLOSE
CLOSF
JFCL
SKIPL RPGSW ;RPG MODE?
JRST DELRP1 ;NO. MUST BE INDIRECT FILE.
HRRZ 1,JFNTBL-2+6 ;GET THE JFN AGAIN
HRLI 1,400000 ;KEEP JFN
DELF ;DELETE FILE
JFCL
DELRP1: HRRZ 1,JFNTBL-2+6
RLJFN
JFCL
SETZM JFNTBL-2+6
JRST @DELRPG
>;TNX
^CTLBUF:BLOCK 3
NOTNX,<RPGBUF: BLOCK 203> ;BUFFER SPACE FOR RPG/TMPCOR/COMMAND-FILE
TNX,<RPGBUF__INDBF>
RPGNAM: BLOCK 4
ZEROS: REPEAT 4,<0>
BEND RPG
;HERE TO READ COMMAND LINE OR CMD FILE
IN: 0 ;JSR HERE. RETURN CHARACTER IN 2.
SKIPE RPGSW ;RPG MODE? (RPG OR @ FILE)
JRST RPGIN ;YES. DO IT FROM FILE
IN1: ILDB 2,TTYPTR ;GET A BYTE FROM THE TTY
JUMPN 2,@IN ;IF NOT NULL, RETURN IT
MOVE 2,[440700,,TTYBUF] ;INITIALIZE BYTE POINTER
MOVEM 2,TTYPTR
NOTNX,<
MOVEM 2,SOUT
ITS,<
AOSN DDTCMD
JRST [MOVE 2,[TTYBUF,,TTYBUF+1]
SETZM TTYBUF
BLT 2,TTYBUF+TTYBFL-1
.BREAK 12,[5,,TTYBUF]
JRST IN1]
>;ITS
IN2: INCHWL 2 ;WAIT FOR A NEW LINE
ANDI 2,177 ;MASK CHARACTER
JUMPE 2,IN2 ;FLUSH NULLS
CAIN 2,15
JRST IN2 ;AND FLUSH CRS
IDPB 2,SOUT ;STORE CHARACTERS
CAIE 2,12
JRST IN2
MOVEI 2, ;STOP ON LF. INVENT A NULL
IDPB 2,SOUT
JRST IN1 ;IT'S NOT OBVIOUS WHY IT'S DONE THIS WAY
SOUT: 0
>;NOTNX
TNX,<
TSVAC <1,3>
HRROI 1,TTYBUF
MOVEI 2,5*TTYBFL-2
NOT20,< SETZ 3, ;SHORT FORM CALL
PSTIN ;IMSSS LOCAL >;NOT20
T20,< HRROI 3,[ASCIZ/*/]
RDTTY
ERJMP .+1
MOVEI 3,0 >;T20
IDPB 3,1 ;END WITH NULL
TRSTAC <1,3>
JRST IN1 ;ONWARD...
>;TNX
TTYPTR: 0
TTYBFL__40
TTYBUF: BLOCK TTYBFL
; START HERE
STRT: TDZA T,T
MOVNI T,1
MOVEM T,RPGSW ;SAVE STATE OF RPG SWITCH
MOVE T,[JSR UUO]
MOVEM T,41 ;UUO HANDLER
MOVE T,[350700,,TLBLK+1]
MOVEM T,LSTPNT ;SET UP EARLY FOR ERR PRT
MOVE P,[-PLEN,,PDL-1] ;AND THE STACK.
PUSHJ P,GTCPTM ;GET STARTING CPU TIME
ITS,< SETZM DDTCMD
.SUSET [.ROPTI,,1]
TLNE 1,OPTCMD
SETOM DDTCMD >;ITS
PUSHJ P,CORINI ;SET UP MPV INTERRUPTS (FOR OPSET)
T20,< SETZM TMPCOR#> ;no tmpcor to start
IFN TMPCSW,< SETZM TMPCOR# > ;
IFN STANSW,< SKIPN OPSOK
PUSHJ P,OPSET ;DEFINE SYSTEM OPCODES FIRST TIME >;STANSW
SETZM UNIVSW ;NOT DOING UNIVERSALS YET
PUSHJ P,SETRPG
JRST RPGGO ;WE ARE HAVE STARTED RPG MODE SUCESSFULLY
SETZM RPGSW ;REG/RPH 11/26/74. RPGSW_0 IF SETRPG FAILS
NOITS,< HLLZS 42> ;NOT IN RPG MODE. CLEAR ERROR CELL.
;HERE AFTER COMPLETE ASSEMBLY, OR WHEN COMMAND FILE RUNS OUT.
STRT1: MOVE P,[-PLEN,,PDL-1] ;DON'T USE OLD STACK MADE BY /E
SKIPE RPGSW ;ARE WE IN RPG MODE?
JRST RPGRS ;SCAN TO END OF LINE OF RPG FILE. TO RPGGO
RESET
PUSHJ P,CORINI ;RE-ENABLE INTS AFTER RESET (SIGH)
PUSHJ P,USHUFF ;SHUFFLE UNIVERSALS. SET JOBFF FROM JOBSA
NOTNX,< MOVE 1,.JBFF ;SHRINK CORE BEFORE CONTINUING
CORE 1,
JFCL >;NOTNX
RPGGO: MOVE P,[-PLEN,,PDL-1]
PUSHJ P,USHUFF ;SHUFFLE UNIVERSALS. SET JOBFF FROM JOBSA
FOR A IN (NOEXP#,TTYERR#,SYMOUT#,XL1IG#,PSWIT#,ESWIT#,<LISTSW#>
,NOLTSW#,CREFSW#,XCRFSW#,INLINE#,<UNDLNS#>
,PGNM,SPGNM,TTYPTR,INCLIN#,FUNSUP)
< SETZM A
>
IFE STOPSW,< SETZM ERSTSW# ;>SETOM ERSTSW#
MOVSI 1
MOVEM CHRCNT#
SETOM LNCNT ;SET THESE TWO CELLS TO FORCE HEADING
AOS PGNM
MOVEI
SKIPN RPGSW
NOITS,< OUTSTR STAR >
ITS,<
JRST [ MOVEI 1,[.FNAM1]
PUSHJ P,FNMOUT
OUTCHR ["."]
MOVEI 1,[.FNAM2]
PUSHJ P,FNMOUT
OUTCHR [15]
OUTCHR [12]
SKIPL DDTCMD
OUTCHR ["*"]
JRST .+1]
>;ITS
MOVEI 1,FILSTK
MOVEM 1,FILSTP ;INITIALIZE FILE-STACK POINTER
SETZM FILSTC ;FILE-STACK DEPTH
MOVE 1,[CXTAB,,CTAB] ;INITIALIZE CHARACTER TABLE
BLT 1,CTAB+177
JSR INITL ;DECODE COMMAND FILE, SET UP BUFFERS..
JRST [RESET ;SOMETHING IS AMISS. AVOID WRITING ANYTHING
SKIPE RPGSW
NOTNX,<EXIT;> HALTF ;IN CASE OF RPG, THE PARTY'S OVER
JRST STRT1] ;FOR MANUAL USER, TRY AGAIN
MOVE 1,.JBFF
MOVEM 1,IOFF# ;SAVE ADDRESS ABOVE THE IO BUFFERS
IFN STANSW,< PUSHJ P,TVSKIP >;MAYBE SKIP DIRECTORY AT STANFORD
IFE STANSW,< PUSHJ P,INP > ;READ INITIAL RECORD
;HERE FROM PRGEND TO START NEXT ASSEMBLY.
STRT2: MOVE P,[-PLEN,,PDL-1]
MOVE 1,IOFF
MOVEM 1,.JBFF ;RESET .JBFF TO INCLUDE IO BUFFERS - NOT MACRO PDL
PUSHJ P,USHUF1 ;SHUFFLE UNIVERSALS. (IOACTIVE. DON'T REDUCE .JBFF)
SETZM SYMTAB
MOVE 1,[XWD SYMTAB,SYMTAB+1]
BLT 1,HASH-1+SYMTAB ;CLEAR USER SYMBOL TABLE
MOVE 1,[XWD OPCDS1,OPCDS] ;INITIALIZE OPCODE TABLE FROM
BLT 1,HASH-1+OPCDS ;PREFINED+CALLIS
MOVE 1,[XWD MACRT1,MACRT] ;INITIALIZE MACRO TABLE
BLT 1,HASH-1+MACRT
MOVE 1,[CXTAB,,CTAB] ;INITIALIZE CHARACTER TABLE
BLT 1,CTAB+177
SETZM LSTLAB ;CLEAR LAST LABLE NAMES
MOVE 1,[LSTLAB,,LSTLAB+1]
BLT 1,LSTLAB+4
ITS,< PUSHJ P,GETSYS > ;GET SYSTEM SYMBOLS
ANDI IOFLGS ;CLEAR ALL BUT I/O FLAGS
FOR A IN (LOCNT#,%BCUR,POLPNT#,SEG#,<RTFLST#>
,XPUNGS#,SYMEM#,CODEM#,VARLST#,LGARB,XL2SW#,TABMSW#)
< SETZM A
>
SETOM XPNDSW
SETOM INMCSW#
SETOM TITLSW#
MOVE FS,['.MAIN']
MOVEM FS,BNAM ;SET INITIAL PROGRAM NAME
MOVEM FS,LSTLAB+3
PUSHJ P,R5CON
MOVEM FS,TPOL3 ;SAVE RADIX50 FOR NAME BLOCK OUTPUT
MOVSI FS,12 ;PROCESSOR ID 12 = FAIL IN BLOCK TYPE 6
MOVEM FS,TPOL4
MOVE 2,[XWD -ERPLEN,ERPD-1]
MOVEM 2,ERPNT
MOVE 1,PSWIT
ADDI 1,1
LSH 1,7 ;FORM MACRO PDL LENGTH
SKIPG 3,ESWIT ;ANY EXTRA LONG MAIN PDL?
JRST .+3 ;NO.
LSH 3,7
ADDI 3,PLEN ;SIZE OF NEW PDL
MOVE M,.JBFF
MOVEI 2,=1024*5(M) ;FIRST FREE + 5K
ADDI 2,(1) ;+SIZE OF MACRO PDL
ADDI 2,(3) ;+SIZE OF MAIN PDL
NOTNX,< CORE 2,> ;GET THE CORE. IF ANYONE NEEDS LESS THAN
TNX,< MOVEM 2,.JBREL
CAILE 2,MXCOR ;WATCH FOR OVERFLOW INTO BUFFERS AND DDT
>;TNX
PUSHJ P,COERR ;5 K, HE DESERVES OUR CONGRATULATIONS.
ADDM 1,.JBFF ;ADVANCE JOBFF PAST THE MACRO PDL
SUBI M,1
MOVNS 1
HRL M,1 ;MACRO PDL POINTER NOW IS IN M
JUMPE 3,STRT2A ;JUMP UNLESS BUILDING EXTRA PDL
MOVE P,.JBFF ;HERE'S WHERE THE PDL STARTS
ADDM 3,.JBFF ;ADVANCE JOBFF PAST THE MAIN PDL
SUBI P,1
MOVNS 3
HRL P,3 ;MAIN PDL POINTER NOW IS IN M
STRT2A:
HRRZ 2,.JBREL ;GET END OF CORE
MOVEI 3,-1(2)
HRRZ 5,.JBFF ;GET END OF PROGRAM
SUB 3,5 ;FORM LENGTH OF FREE AREA
ASH 3,-1
MOVEM 2,MTBLST# ;SET END OF FREE AREA
MOVE 2,5
ADD 2,3
MOVEM 2,MTBPNT# ;FORM START OF FREE AREA
IDIVI 3,5 ;FORM COUNT
MOVEM 5,FSTPNT# ;START OF FREE STRG
ADDI 5,5 ;INCREMENT TO NEXT
MOVEM 5,-4(5) ;STORE LINK
SOJG 3,.-2 ;LOOP
SETZM -4(5) ;TERMINATE
SETZM LOCNT
SETZM ABSCNT#
MOVEI T,LOCNT
MOVEM T,CURBRK#
MOVEI CP,400000
MOVEM CP,HICNT#
HLLOS BRK#
SETZM PCNT ;LOCATION COUNTERS. RELOC 0
MOVEI T,1
MOVEM T,PCNT+1
SETZM OPCNT
MOVEM T,OPCNT+1
SETZM DPCNT
MOVEM T,DPCNT+1
MOVEI CP,ASSMBL ;GET ADDRESS
MOVEM CP,CPDL ;INITIALIZE THE SPECIAL PDL
MOVE CP,[XWD CPDL,CPDL+1] ;USED FOR THE
BLT CP,CPDL+CPLEN-1 ;RECURSIVE CO-ROUTINE ASSMBL
MOVE CP,[XWD SNB+CPLEN-3,CPDL+CPLEN-2]
SETZB BC,FBLK+1
MOVE FC,[XWD -22,FBLK+2]
PUSHJ P,SBINI ;INITIALIZE SYMBOL OUTPUT.
MOVNI B,BBLK+2
HRRM B,BFX
MOVNI B,FBLK+2
HRRM B,FFX
MOVE B,[POINT 7,TLBLK+1,6]
MOVEM B,LSTPNT
MOVSI B,(<ASCII / />)
MOVEM B,TLBLK+1
MOVE B,[POINT 7,CREFTB,13]
MOVEM B,CREFPT
MOVE B,[LSH N,3]
MOVEM B,SRAD
MOVE B,CTAB+"8"
MOVEM B,RTEST
MOVEI B,LINLEN ;NORMAL LINE SIZE - JHS
SKIPE CREFSW ;EXCEPT, ARE WE CREFFING?
MOVEI B,LINLEN-10 ;YES - REDUCE LINE SIZE BY 8
MOVEM B,CHRPL
MOVEI B,LNPP
SKIPN PAGSIZ
MOVEM B,PAGSIZ ;INITIALIZE PAGE SIZE UNLESS SET BY SWITCH.
MOVE B,[LITPNT-1,,LITPNT]
BLT B,LITPNT+HASH-1
MOVEI B,1
MOVEM B,BLOCK
MOVE B,[XWD DAF,-1]
MOVEM B,DBLCK
MOVE B,[XWD SNULN,NULN]
BLT B,NULN+5
MOVE B,[XWD -EFSLEN,EFS-1]
MOVEM B,EFSPNT#
SETZM TITCNT+1
MOVE B,[XWD -1,TITCNT+1]
MOVEM B,TITCNT
MOVE B,[XWD -1,SUBCNT+1]
MOVEM B,SUBCNT
NOTNX,< MOVE B,[BYTE (7)15,12,15,12]>
TNX,< MOVE B,[BYTE (7)11,11,11,11,11]
SETZM SUBCNT+2
>;TNX
MOVEM B,SUBCNT+1
SETZM GARBAG
IFN STANSW,< MOVEI C,OPSET
MOVEI B,OPSEND
PUSHJ P,MACRET > ;GIVE OPCODE-GETTER TO FREE STORAGE
TNX,< PUSHJ P,INISM > ;SET INITIAL SYMBOL TABLE.
JRST MAIN ;OFF TO SEE THE WIZARD, THE WONDERFUL ...
;NOFSL
CELCNT: 0
BEGIN NOFSL
^NOFSL: 0 ;JSR HERE WHEN OUT OF FREE STORAGE
PUSH P,O
PUSH P,T ;SAVE
PUSH P,FS ;...
PUSH P,N
PUSH P,NA
MOVEI NA,GARBAG-1
SKIPN T,GARBAG ;GET GARBAGE LIST
JRST NOGAR ;NONE
SETZB FS,CELCNT ;ZERO CELL COUNT
LOOP2: MOVE O,2(T) ;GET START ADDRESS
MOVE N,(T) ;GET COUNT
CAIGE N,5 ;BIG ENOUGH?
JRST NOMO ;NO
LOOP1: MOVEM FS,1(O) ;DEPOSIT POINTER
MOVE FS,O ;FORM NEW ONE
ADDI O,5
SUBI N,5 ;DECREASE COUNT
AOS CELCNT
CAIL N,5 ;ROOM FOR MORE?
JRST LOOP1 ;YES
NOMO: JUMPE N,USET ;USED IT ALL?
MOVEM N,(T) ;NO, DEPOSIT NEW COUNT
MOVEM O,2(T) ;DEPOSIT NEW START
MOVE NA,T
SKIPN T,1(T) ;GET NEXT
JRST NOMGAR ;NO MORE GARBAGE
JRST LOOP2
USET: MOVE O,1(T) ;GET POINTER
MOVEM O,1(NA) ;REMOVE THIS CELL...
MOVEM FS,1(T) ;& PUT INTO
MOVE FS,T ;FREE STORAGE
AOS CELCNT
SKIPE T,O
JRST LOOP2
NOMGAR: SKIPE T,GARBAG
MOVE T,3(T)
MOVEM T,LGARB
MOVE T,CELCNT
CAIGE T,20 ;WERE AT LEAST 20 CELLS CREATED?
JRST NOTNUF ;NO
LOOP4: MOVE T,NOFSL ;GET ADDRESS
LDB O,[POINT 4,-2(T),12] ;GET AC FLD
DPB O,[POINT 4,RSET,12] ;DEPOSIT
POP P,NA
POP P,N ;RESTORE
HRRM FS,RSET ;DEPOSIT FREE STORAGE POINTER
POP P,FS
POP P,T
POP P,O
RSET: MOVEI ;LOAD NEW POINTER ***AC AND ADDRESS CLOBBERED***
JRST @NOFSL ;RETURN
NOGAR: MOVEI FS,0
NOTNUF: MOVE T,.JBREL ;GET END OF CORE
SUB T,MTBPNT ;SUB CURRENT START OF FREE AREA
CAIGE T,300 ;AT LEAST 300 WORDS LEFT?
PUSHJ P,COEXP ;NO, EXPAND CORE
MOVE T,.JBREL ;GET DIF
SUB T,MTBPNT ;...
LSH T,-1 ;DIV BY 2
ADD T,MTBPNT ;USE HALF FOR FREE STRG
MOVE O,MTBPNT ;GET START
LOOP3: MOVEM FS,1(O) ;DEPOSIT POINTER
MOVE FS,O ;GET NEW ONE
ADDI O,5 ;GO TO NEXT
CAMGE O,T ;FAR ENOUGH?
JRST LOOP3 ;NO
MOVEM O,MTBPNT ;YES, DEPOSIT NEW MTBPNT
JRST LOOP4
;CORINI, COEXP, WAIT, TSINT, PDLOV, PDLOVI
SV: BLOCK 2 ;TEMP CELLS FOR MPV INTERRUPTS
NOTNX,<
^COERR: OUTSTR [ASCIZ/
Need more core but none is available. Strike any key to try again:/]
PUSHJ P,WAIT
^COEXP: MOVE T,.JBREL ;GET CURRENT END OF CORE
ADDI T,2000 ;EXPAND BY 1K
CORE T,
JRST COERR ;NO CORE
POPJ P,
^WAIT: CLRBFI
INCHRW T
CAIN T,15
INCHRW T
POPJ P,
^CORINI:MOVEI T,IFE STANSW,<620000;>220000 ;REPETITIVE ENABLE ON DEC SYSTEMS
APRENB T,
MOVEI T,.JBAPR-1
PUSHJ T,CORI2
HRRZS O,T ;TRAP HERE TO SEE HOW MUCH PC CHANGED
SUBI O,@.JBTPC
JRST 2,1(T) ;SKIP TEST INSTR, CLEAR FLAGS (ESP. BIS)
CORI2: JSP T,.+1
SETZM -1 ;GET PC OFFSET FOR WRITE INSTRUCTIONS
MOVEM O,REGOFF#
JSP T,.+1
DPB [,-1] ;GET OFFSET FOR BYTE INSTRUCTIONS
MOVEM O,BYTOFF#
MOVEI T,.JBAPR-1
PUSHJ T,CPOPJ ;SET TRAP ADDRESS TO TSINT
^TSINT: MOVEM FS,SV ;SAVE
MOVEM T,SV+1
MOVE T,.JBCNI
TRNE T,200000
JRST PDLOVI
MOVE FS,.JBTPC ;GET PC WORD
TLNE FS,20000 ;TEST BIS FLAG TO SEE IF LOSING INST WAS BYTE INST
SKIPA FS,BYTOFF ;SELECT APPROPRIATE OFFSET
MOVE FS,REGOFF
ADDB FS,.JBTPC ;ADD OFFSET TO PC WORD
ANDI FS,-1 ;GET RID OF FLAGS
MOVSI T,-LEGCNT
LOP1: CAME FS,LEGTAB(T) ;SEE IF LEGAL PC
AOBJN T,LOP1
JUMPL T,MPVOK
OUTSTR [ASCIZ/
Assembler error: Unexpected ILL MEM REF. at user PC = /]
PUSH P,FS
PUSH P,FS+1
PUSHJ P,OCTTYO
POP P,FS+1
POP P,FS
OUTSTR TTCRLF
PUSHJ P,TTYERP
OUTSTR [ASCIZ/Type any key to continue anyway: /]
PUSHJ P,WAIT
MPVOK: PUSHJ P,COEXP ;EXPAND CORE
MOVE FS,SV
MOVE T,SV+1 ;RESTORE
JRST 2,@.JBTPC ;& RETURN
OCTTYO: IDIVI FS,10
HRLM FS+1,(P)
JUMPE FS,.+2
PUSHJ P,OCTTYO
HLRZ FS,(P)
ADDI FS,"0"
OUTCHR FS
POPJ P,
>;NOTNX
PDLOVI: MOVEI T,[ASCIZ /UNRECOGNIZABLE/]
JUMPL CP,.+2
MOVEI T,[ASCIZ /COROUTINE/]
JUMPL M,.+2
MOVEI T,[ASCIZ /MACRO/]
JUMPL P,.+3
^PDLOV: MOVEI T,[ASCIZ /MAIN/]
ANDI P,-1 ;AVOID RECURSIVE PDLOVS
OUTSTR (T)
OUTSTR [ASCIZ / PDL OVERFLOW, CAN'T CONTINUE.
/]
JUMPL M,.+2
OUTSTR [ASCIZ \USE /P TO EXPAND MACRO PDL
\]
JUMPL P,.+2
OUTSTR [ASCIZ \USE /E TO EXPAND MAIN PDL
\]
PUSHJ P,LSTCHK ;MAKE SURE WE CAN TYPE LISTING BUFFER
PUSHJ P,TTYERP
TNX,< HALTF JRST .-1>
NOTNX,< HALT . >
TNX,<
^COEXP: MOVE T,.JBREL ;HERE TO EXPAND CORE - GET CURRENT END OF CORE
TRO T,1777 ;JUST TO BE ON PAGE BOUND ALWAYS
ADDI T,2000
CAILE T,MXCOR ;WATCH BUFFERS AND DDT
JRST COERR ;REALLY?
MOVEM T,.JBREL ;MAINTAIN THE FICTION
POPJ P,
^COERR: OUTSTR [ASCIZ /
Virtual memory is full. Can't continue.
/]
HALTF
JRST .-1
^WAIT: MOVEI 1,100 ;PRIMARY INPUT
CFIBF
PBIN ;WAIT
POPJ P,
^CORINI:RESET ;WHY NOT?
^CORINX:MOVEI 1,400000 ;THIS FORK
MOVE 2,[LEVTAB,,CHNTAB]
SIR ;SET TABLE ADDR
EIR ;ENABLE SYSTEM
MOVE 2,[000400,,020000] ;PDLOV, NXPG
AIC ;ARM
POPJ P,
;STORAGE FOR INTERRUPT SYSTEM
SVEADR: 0 ;EFFECTIVE ADDR OF ILLEGAL REFERENCE
^SVPCS: BLOCK 3 ;PC AT INTERRUPT TIME
^LEVTAB:SVPCS
SVPCS+1
SVPCS+2
^CHNTAB:BLOCK =9
XWD 1,PDLOVI ;PDL OVERFLOW
BLOCK =12
XWD 1,TSINT ;NXPG
BLOCK =9
^TSINT: MOVEM FS,SV ;SAVE
MOVEM T,SV+1
MOVEI 1,400000 ;THIS FORK
GTRPW
TLNE 1,1
JRST LEGREF ;MONITOR MODE IS SPURIOUS
HRRZ 2,1 ;EFFECTIVE ADDR OF OFFENDING WORD
MOVEM 2,SVEADR ;SAVE IT
CAMG 2,.JBREL
JRST LEGREF ;FIRST HIT ON ALLOCATED PAGE
IFN TOPS20,< CAIL 2,700000 ;IS THIS A REFERENCE TO IOSPACE?
JRST LEGREF >;YES, I HOPE. LET IT BE.
HRRZ FS,SVPCS ;ADDR OF OFFENDING INSTR
IFE TOPS20,< SUBI FS,1 > ;PC+1 ON TENEX
;DONT BELIEVE JSYS MANUAL ABOUT THAT TRAP WORD...
MOVSI T,-LEGCNT
LOP1: CAME FS,LEGTAB(T) ;SEE IF LEGAL PC
AOBJN T,LOP1
JUMPL T,MPVOK
OUTSTR [ASCIZ/
Assembler error: Unexpected ILL MEM REF. at user PC = /]
PUSH P,1
PUSH P,2
PUSH P,3
HRRZ 2,FS ;ARGUMENT IN 2
MOVEI 1,101 ;PRIMARY OUTPUT DEVICE
MOVE 3,[140006,,10] ;6 CHARACTERS, RADIX 8, LEADING 0 FILL
NOUT
JFCL
POP P,3
POP P,2
POP P,1
OUTSTR TTCRLF
PUSHJ P,TTYERP
OUTSTR [ASCIZ/Type any key to continue anyway:/]
PUSHJ P,WAIT
MPVOK: MOVE T,SVEADR ;GET ADDRESS THAT WE MUST MAKE LEGAL
IORI T,1777
CAILE T,MXCOR ;WITHIN MAX ALLOCATION OF VIRTUAL MEM?
JRST COERR ;NO. LOSE
MOVEM T,.JBREL ;SIMULATE THIS ADDRESS BEING LEGAL
LEGREF: MOVE FS,SV
MOVE T,SV+1 ;RESTORE
DEBRK ;DISMISS INTERRUPT
>;TNX
BEND NOFSL
SUBTTL CHARACTER TABLE FOR SCANNER
CTAB: BLOCK 200
CXTAB: 0 ;0 NULL
XWD SPCLF,UDARF!TP1F ;1 DOWN ARROW
XWD SPCLF,0 ;2 ALPHA
XWD SPCLF,0 ;3 BETA
XWD SPCLF!ARFL!ARMD,6 ;4 LOGICAL AND (CARET)
XWD SPCLF!ARFL!UNOF,12 ;5 LOGICAL NOT
XWD SPCLF,EPSF ;6 EPSILON
XWD SPCLF,0 ;7 PI
XWD SPCLF,0 ;10 LAMBDA
XWD SCRF!SPFL!SPCLF,5 ;11 TAB
XWD SPCLF!LNFD!SCRF,1 ;12 LINE FEED
XWD SPCLF,0 ;13 VERTICAL TAB
XWD SPCLF!SCRF!LNFD,7 ;14 FF (LOOKS SOMETHING LIKE LF)
XWD SPCLF!CRFG,6 ;15 CR (6 IS FOR LOUT)
XWD SPCLF,0 ;16 INFINITY
XWD ARFL!SPCLF!ARMD!ARMD1,10 ;17 PARTIAL (REMAINDER IN DIVISION)
XWD SPCLF,INF ;20 CONTAINMENT (OPEN HORSE SHOE)
XWD SPCLF,0 ;21 (CLOSE HORSE SHOE)
XWD SPCLF,0 ;22 SET INTERSECTION
XWD SPCLF,0 ;23 SET UNION
XWD SPCLF,0 ;24 FOR ALL
XWD SPCLF!ARFL!UNOF!ARMD1,12 ;25 THERE EXISTS - JFFO OPERATOR
XWD SPCLF!ARFL,4 ;26 CIRCLE TIMES
XWD SPCLF!LNFD!CRFG,2 ;27 DOUBLE ARROW. SIMULATE CRLF
XWD SNB!.FL!ENMF,'.' ;30 UNDERSCORE (LOOKS LIKE . IN SYMS)
XWD SPCLF,BSLF ;31 RIGHT ARROW
XWD SPCLF,UDARF!TP2F ;32 TILDA - SAME AS UPARROW
XWD SPCLF!ARFL!ARMD1,6 ;33 NOT EQUALS (XOR)
XWD SPCLF,0 ;34 LESS OR EQUAL
XWD SPCLF!ARFL!ARMD1,6 ;35 GREATER OR EQUAL (XOR)
XWD SPCLF,0 ;36 EQUIVALENCE
XWD SPCLF!ARFL,6 ;37 LOGICAL OR
XWD SCRF!SPCLF!SPFL,5 ;40 SPACE
XWD SPCLF!ARFL,6 ;41 ! LOGICAL OR
XWD SPCLF!SCRF!ENMF,2 ;"
XWD SPCLF,SHRPF ;#
XWD SNB!ENMF,'$' ;$
XWD SNB!ENMF,'%' ;%
XWD SPCLF!ARFL!ARMD,6 ;&
XWD SPCLF!SCRF!ENMF,3 ;'
XWD SPCLF,LFPF ;(
XWD SPCLF,RTPF ;)
XWD SPCLF!ARFL,10 ;*
XWD SPCLF!ARFL,12 ;+
XWD SPCLF,COMF ;,
XWD SPCLF!ARFL!ARMD!UNOF,12 ;-
XWD SNB!.FL!ENMF,'.' ;.
XWD ARFL!SPCLF!ARMD,10 ;/
XWD SNB!NMFLG!ENMF,'0' ;0
XWD SNB!NMFLG!ENMF,'1' ;1
XWD SNB!NMFLG!ENMF,'2' ;2
XWD SNB!NMFLG!ENMF,'3'
XWD SNB!NMFLG!ENMF,'4'
XWD SNB!NMFLG!ENMF,'5'
XWD SNB!NMFLG!ENMF,'6'
XWD SNB!NMFLG!ENMF,'7'
XWD SNB!NMFLG!ENMF,'8'
XWD SNB!NMFLG!ENMF,'9'
XWD SPCLF,LACF!TP2F ;:
XWD SPCLF!CRFG,2 ;;
XWD SPCLF!SCRF!ENMF!LBRF,10 ;WILL BE XWD SPCLF!ENMF!LBRF,LBCF!TP2F;<
XWD SPCLF!SCRF!ENMF,4 ;=
XWD SPCLF!SCRF!RBRF,11 ;WILL BE XWD SPCLF!RBRF,TP2F!RBCF;>
XWD SPCLF,UDARF!TP1F ;? SAME AS DOWN-ARROW
XWD SPCLF,ATF ;@
XWD SNB!ENMF,'A' ;A
XWD SNB!ENMF!BFL,'B' ;B POSSIBLE BINARY SHIFTING
XWD SNB!ENMF,'C' ;C
XWD SNB!ENMF,'D' ;D
XWD SNB!ENMF!EFL,'E' ;E POSSIBLE EXPONENT IN FLOATING NUMBER
FOR I_'F','Z'
<XWD SNB!ENMF,I
>
XWD SPCLF!ENMF!LBRF,TP1F;[
XWD SPCLF,BSLF ;\
XWD SPCLF!RBRF,TP1F ;]
XWD SPCLF,UDARF!TP2F ;^
XWD SPCLF,LACF!TP1F ;_
XWD SPCLF,ATF ;140 ` SAME AS @
XWD SNB!ENMF,'A' ;a
XWD SNB!ENMF!BFL,'B' ;b
XWD SNB!ENMF,'C' ;c
XWD SNB!ENMF,'D' ;d
XWD SNB!ENMF!EFL,'E' ;e
FOR I_'F','Z'
<XWD SNB!ENMF,I
>
XWD SPCLF!SCRF,10 ;WILL BE XWD SPCLF,LBCF!TP2F;{
XWD SPCLF!ARFL!UNOF!ARMD!ARMD1,12 ;174 VERTICAL BAR - ABS OPERATOR
XWD SPCLF!SCRF,11 ;WILL BE XWD SPCLF,RBCF!TP2F;}
XWD SPCLF!SCRF,11 ;AS ABOVE
XWD SPCLF!SCRF!DLETF,0 ;DELETE
0
COMBTS__SCRF!SPCLF!ENMF!LBRF!RBRF!DLETF!LNFD ;OR OF BITS FOR LF DEL <>{}
BEGIN SCAN SUBTTL SCANNER AND FRIENDS
;RETURNS WITH NEXT THING
;IF AN IDENTIFIER -- SIXBIT IN L
;IF A NUMBER -- VALUE IN N AND NA
;IF A SPC. CHR. -- BITS FOR CHR IN N
;IN ALL CASES, THE NEXT NON-BLANK CHR. AFTER THE
; THING RETURNED IS IN C AND ITS BITS ARE IN B.
^SCAN: MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM
TLZE SFL ;SHOULD WE RETURN CURRENT THING?
JRST AHEDW ;YES
LOOP3: ILDB C,INPNT ;GET CHR.
LOOP3A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING
^AHED: TDNE L,@INPNT ;LINE NUM?
JRST LNUM ;YES
SKIPL B,CTAB(C) ;GET BITS, IS IT NUM OR LET?
AHEDW: JUMPGE B,SPCRET ;NO
TLNE B,NMFLG ;NUM?
JRST NUMS ;YES. COLLECT NUMBER
HRRZ L,B ;IT'S A LETTER, PUT IN L
LOOP3B: ;here from DSCAN; ACT NORMAL
REPEAT 5,< ILDB C,INPNT ;GET NEXT
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS
JSR NOLT ;NOT LET OR NUM
LSH L,6
ORI L,(B) ;OR IN SIXBIT>
LOOP1: ILDB C,INPNT ;GET NEXT CHR.
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS, LET OR NUM?
JSR NOLT ;NO
JRST LOOP1 ;YES,SKIP
NOLT: 0
JUMPN B,NOLT1
JSP B,NULSKP
ILDB C,INPNT
IDPB C,LSTPNT
SKIPGE B,CTAB(C)
JRST @NOLT
NOLT1: TLNE B,SCRF ;SPC HANDLING?
XCT NOLB(B) ;YES
TLO SFL!IFLG ;SET 'SCAN AHEAD' AND 'IDENT'
TLZ NFLG!SCFL!FLTFL ;CLEAR NUM & SPC.CHR.
POPJ P,
DEFINE EMPS (A)
< PUSHJ P,LBROK
JRST A>
;HERE TO SCAN NUMBERS
^RTEST: SNB!NMFLG!ENMF,,'8' ;Test for bad digits
NUMS: MOVEI N,-20(B) ;PUT VALUE IN N FIRST DIGIT
TRZ RWARN1!RWARN2 ;CLEAR DIGIT WARNINGS FOR BAD RADIX
CAML B,RTEST ;SKIP IF THIS DIGIT IS OK
TRO RWARN1 ;SET FIRST DIGIT IS BAD FLAG
SKIPA NA,FLTB-20(B) ;FLOATING VALUE ACCUMULATES IN NA
LOOP2A: JSP B,NULSKP
LOOP2: ILDB C,INPNT ;GET NEXT CHR.
IDPB C,LSTPNT
NLOP: SKIPL B,CTAB(C) ;GET BITS
JRST NONM ;NOT A LETTER OR A NUMBER
TLNN B,NMFLG ;NUM?
JRST NLET ;NO, LETTER FOLLOWS NUMBER (OR .)
^SRAD: LSH N,3 ;MULT BY RADIX (THIS GETS CLOBBERED)
ADDI N,-20(B) ;ADD IN THIS DIGIT
FMPR NA,[10.0] ;MULT FLOATING BY 10
FADR NA,FLTB-20(B) ;ADD IN THIS DIGIT
TRNN RWARN1!RWARN2 ;IS EITHER WARNING SET?
CAML B,RTEST ;NO WARNING YET. SHOULD WE SET IT?
TRO RWARN2 ;YES. THIS IS DEFINITE MISTAKE.
JRST LOOP2
NLET: TLNE B,.FL ;LETTER FOLLOWS NUM. IS IT "."?
JRST DOT ;YES, DO FLOATING POINT THING
TLNE B,BFL ;B?
JRST BSH ;B-SHIFT OPERATOR
TLNE B,EFL ;E?
JRST EXP
ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
NONM: JUMPE B,LOOP2A ;NULL TYPE CHR?
TRNE RWARN2 ;NUMBER ERROR?
ERROR [ASCIZ/INCORRECT DIGITS FOR THIS RADIX/]
NONM1: TLNE B,SCRF ;SPC HAND?
XCT NOTB(B) ;YES
MOVEI NA,
TLO SFL!NFLG ;SET 'AHEAD' AND NUM
TLZ SCFL!IFLG!FLTFL ;CLEAR SPC,CHR & IDENT
POPJ P,
FLTB: DEC 0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0
NOTB: JRST NOND
PUSHJ P,LSTLF
JFCL
JFCL
JFCL
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BNOTB
BNOTB: PUSHJ P,RTBFND
JRST NONM
JRST LOOP2
NOND: DELHN
JRST NLOP
EQLS: PUSHJ P,SCAN1 ;PEEK AHEAD
CAIE C,74 ;POINTED BRACKET?
JRST EQLS1 ;NO
MOVEI N,12
MOVEM N,DHRADX ;SAVE FOR HACK RADIX
PUSHJ P,SPCRET ;MAKE IT LOOK REAL
JRST XSCANS ;TIE THE STACK IN KNOTS!
EQLS1: TLO SFL ;MAKE SURE WE SCAN THIS AGAIN
PUSH P,SRAD ;SAVE CURRENT RADIX
PUSH P,RTEST
MOVE N,[IMULI N,12] ;SET TO 10...
MOVEM N,SRAD ;...
MOVE N,CTAB+"0"
ADDI N,12
MOVEM N,RTEST
PUSHJ P,SCAN ;SCAN NUMBER
POP P,RTEST
POP P,SRAD ;RESTORE RADIX
TLNN NFLG ;WAS A NUMBER SEEN?
ERROR [ASCIZ/NOT A NUMBER AFTER EQUALS/]
POPJ P,
;HERE TO DO FLOATING POINT NUMBERS
DOT: MOVE N,NA ;GET FLOATING NUM SO FAR
SKIPA NA,[1.0] ;Accumulate divisor
LOOP5A: JSP B,NULSKP
LOOP5: ILDB C,INPNT ;GET NEXT
IDPB C,LSTPNT ;DEPOSIT
DNLOP: SKIPL B,CTAB(C) ;GET BITS
JRST DNONM ;NOT NUM - Do DIVISION
TLNN B,NMFLG ;NUM?
JRST DNLET ;NO,LETTER
FMPR N,[10.0] ;ACCUMULATE NEW DIGIT
FADR N,FLTB-20(B)
FMPR NA,[10.0] ;And accumulate divisor
JRST LOOP5
DNLET: FDVR N,NA ;DIVIDE TO ADJUST FRACTION DIGITS
TLNE B,EFL ;E?
JRST EXP1 ;YES
ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
JRST DNONM2 ;some ordinary letter has been seen
EXP: MOVE N,NA ;GET FLOATING VERSION
EXP1: PUSHJ P,SCAN1 ;GET NEXT CHR.
MOVEI NA,EXT1
HRRM NA,EXTP
TLNN B,UNOF ;- OR NOT (TREAT BOTH THE SAME)?
JRST PT5 ;NO
MOVEI NA,EXT2 ;YES, HANDLE...
HRRM NA,EXTP ;...
PUSHJ P,SCAN1 ;GET NEXT
PT5: TLNN B,NMFLG ;NUM?
ERROR [ASCIZ/NO NUM AFTER E/]
MOVEI NA,-20(B) ;GET VALUE
PUSHJ P,SCAN1 ;GET NEXT
TLNN B,NMFLG ;NUM?
JRST PT6 ;NO
ADDI NA,12 ;SECOND HALF OF TABLE
FMPR N,@EXTP ;SCALE
MOVEI NA,-20(B) ;GET VALUE
PUSHJ P,SCAN1 ;GET NEXT
PT6: FMPR N,@EXTP ;SCALE
TLNE B,NMFLG
ERROR [ASCIZ/TOO MANY NUMS AFTER E/]
JRST DNONM2 ;anything special already done by SCAN1
DNONM: JUMPE B,LOOP5A ;NULL TYPE?
DNONM1: TLNE B,SCRF ;SPECIAL AHNDLE?
XCT DNOTB(B) ;YES, HANDLE
FDVR N,NA ;DIVIDE TO ADJUST FRACTION DIGITS
DNONM2: MOVSI NA,FLTFL ;SET AS FLOATING
TLO SFL!NFLG!FLTFL ;SET NUM&FLOATING & AHEAD
TLZ IFLG!SCFL ;CLEAR SPC CHR. & IDENT
POPJ P,
DNOTB: JRST DNDH ;DELETE
PUSHJ P,LSTLF ;LF
JFCL
JFCL
JFCL
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BDNOTB
BDNOTB: PUSHJ P,RTBFND
JRST DNONM1
JRST LOOP5
DNDH: DELHN
JRST DNLOP
EXTP: XWD NA,EXT1
EXT1: 1.0
10.0
100.0
1000.0
10000.0
100000.0
1000000.0
10000000.0
100000000.0
1000000000.0
1.0
1.0E10
1.0E20
1.0E30
1.0E40
1.0E50
1.0E60
1.0E70
1.0E80
1.0E90
EXT2: 1.0
0.1
0.01
0.001
0.0001
0.00001
0.000001
0.0000001
0.00000001
0.000000001
1.0
1.0E-10
1.0E-20
1.0E-30
1.0E-40
1.0E-50
1.0E-60
1.0E-70
1.0E-80
1.0E-90
;DSCAN, DSCANM, DSCANS
;DSCAN HANDLE ^D69, etc, CALLED TO SIMULATE SCANS,SCANM, and SCAN
DHTBL: 10,,'O'
12,,'D'
2,,'B'
DHTBLN==.-DHTBL
;SCAN ALLOWING ^D89 for instance. ^ SEEN ALREADY. NEXT MUST
;BE EITHER: ^, an identifier and colon, or one of the special forms
^DSCANS:PUSHJ P,DSCANM ;SIMULATE CALL TO SCANM
TLNE N,LBRF ;WAS EITHER [ or < SEEN?
TLNN SCFL ;SPECIAL CHARACTER?
JRST SCANS1 ;NOT SPECIAL
SKIPE DHACK ;SKIP IF ORDINARY RETURN FROM DSCAN
TRNE N,TP1F ;< SEEN?
JRST SCANS1 ;NOPE. IT WAS [
^XSCANS:PUSH P,SRAD ;ENTER HERE FROM SCANS IF SPECIAL FLAG
PUSH P,RTEST
MOVSI TAC,(<IMULI N,>)
HRR TAC,DHRADX
MOVEM TAC,SRAD
ADDI TAC,'0'
HRRM TAC,RTEST
PUSHJ P,SCANS1
POP P,RTEST
POP P,SRAD
POPJ P,
DSCANM: PUSHJ P,DSCAN ;SIMULATION OF SCANM
TLNN IFLG ;IDENT SEEN?
POPJ P, ;NOPE
JRST SCANM1 ;LET THE REAL SCANM TAKE OVER
DSCAN: SETZM DHACK# ;ASSUME NORMAL
TLZE SFL ;SHOULD WE RETURN CURRENT THING?
JRST DAHDW
DSLP3: ILDB C,INPNT ;GET CHR.
DSLP3A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING
SKIPL B,CTAB(C) ;GET BITS, IS IT NUM OR LET?
DAHDW: JUMPGE B,SPCRET ;NO
TLNE B,NMFLG ;NUM?
JRST NUMS ;YES. COLLECT NUMBER ERROR!
HRRZ L,B ;IT'S A LETTER, PUT IN L
MOVSI B,-DHTBLN
HRRZ C,DHTBL(B)
CAME C,L
AOBJN B,.-2
JUMPGE B,LOOP3B ;NOT A SPECIAL LEAD IN CHR.
HLRZ C,DHTBL(B)
MOVEM C,DHRADX# ;RADIX TO ACCUMULATE WITH
SETOM DHACK ;ASSUME WE HAVE A CHANCE
MOVEI NA,0 ;ACCUMLATE SLUDGE HERE
REPEAT 5,<
ILDB C,INPNT ;GET NEXT
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS
JSR DSNOLT ;NOT LET OR NUM
LSH L,6
ORI L,(B) ;OR IN SIXBIT
TLNN B,NMFLG ;NUMBER?
SETZM DHACK ;NO. GIVE UP
MOVEI B,-'0'(B) ;REDUCE CHARACTER TO NUMBER
CAML B,DHRADX ;LESS THAN CURRENT RADIX?
SETZM DHACK ;no give up
IMUL NA,DHRADX
ADDI NA,(B)
>
DSLP1: ILDB C,INPNT ;GET NEXT CHR.
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS, LET OR NUM?
JSR DSNOLT ;NO
TLNN B,NMFLG ;NUMBER?
SETZM DHACK ;NO. GIVE UP
MOVEI B,-'0'(B) ;REDUCE CHARACTER TO NUMBER
CAML B,DHRADX ;LESS THAN CURRENT RADIX?
SETZM DHACK ;no give up
IMUL NA,DHRADX
ADDI NA,(B)
JRST DSLP1
DSNOLT: 0
JUMPN B,DSNLT1
JSP B,NULSKP
ILDB C,INPNT
IDPB C,LSTPNT
SKIPGE B,CTAB(C)
JRST @DSNOLT
DSNLT1: TLNE B,SCRF ;SPC HANDLING?
XCT DSNOLB(B) ;YES
;NOW, IF NEXT CHARACTER IS A COLON, LEFT ARROW, OR EQUALS, THEN
;WHAT WE'VE PARSED IS AN IDENTIFIER. IF DHACK IS ZERO, WE
;PARSED AN IDENTIFIER (AND ERROR IS HAPPENING). OTHERWISE,
;WE HAVE A NUMBER, EXCEPT, IF THE IDENTIFIER WE HAVE IS ONE
;LETTER LONG AND TERMINATES WITH AN OPEN BROKET, WE ARE SETTING
;THE RADIX WHILE A COMPLEX ATOM IS PARSED.
SKIPE DHACK
TRNE B,LACF ;COLON OR LEFT-ARROW OR EQUAL?
JRST DSNIDN ;RETURN AN IDENTIFIER
TRNE B,LBCF ;BROKET SEEN?
JRST DSNBRK ;YES. HANDLE IT.
DSNNUM: MOVE N,NA
MOVEI NA,0
TLO SFL!NFLG
TLZ SCFL!IFLG!FLTFL
POPJ P,
DSNBRK: TRNE L,7700 ;ONE CHARACTER ONLY IN NAME? ^D<23*3>
JRST DSNNUM ;NO. DO YOUR WORST.
TLZ NFLG!FLTFL!IFLG
TLO SCFL!SFL
MOVE N,B ;RETURN FLAGS IN N (LIKE SPCRET)
JSR SPCSKP
POPJ P, ;RETURN SPECIAL CHARACTER
DSNIDN: TLO SFL!IFLG ;SET 'SCAN AHEAD' AND 'IDENT'
TLZ NFLG!SCFL!FLTFL ;CLEAR NUM & SPC.CHR.
POPJ P,
DSNOLB: JRST DSNOLD ;DEL
PUSHJ P,LSTLF ;LF
JFCL ;"
JFCL ;'
MOVE B,CTAB+"_" ;MAKE = LOOK LIKE _ AFTER SYMS
JSR SPCSKP ;SP or TAB
JFCL ;unknown
PUSHJ P,NEWPAG ;FF
PUSHJ P,LBROK ;Handle open broket or brace
JRST DBNOLB ;Handle close broket or brace
DBNOLB: PUSHJ P,RTBFND
JRST DSNOLT+1
ILDB C,INPNT
IDPB C,LSTPNT
SKIPL B,CTAB(C)
JRST DSNOLT+1
JRST @DSNOLT
DSNOLD: DELHN
SKIPL B,CTAB(C)
JRST DSNOLT+1
JRST @DSNOLT
^SPCSKP:0 ;skip until non blank
PUSH P,L
MOVEI L,1
SPCCN1: ILDB C,INPNT ;GET NEXT
SPCCN2: IDPB C,LSTPNT ;DEPOSIT
SPCCN3: XCT AHED
JRST [JSR SLNUM
JRST SPCCN1]
SKIPGE B,CTAB(C) ;GET BITS
JRST SPCKRT ;NNUM OR LET
SPCCON: JUMPE B,SPCNUL
TLNE B,SCRF ;SPC. HAND?
XCT SPKT(B) ;YES
SPCKRT: POP P,L
JRST @SPCSKP
SPCNUL: JSP B,NULSKP
JRST SPCCN1
JRST SPCCN2
SPKT: JRST SPCDEL
JFCL
JFCL
JFCL
JFCL
JRST SPCCN1
JFCL
JFCL
EMPS BSPKT
BSPKT: PUSHJ P,RTBFND
JRST SPCKRT
JRST SPCCN1
SPCDEL: DELHN
JRST SPCCN3
SPCRET: JUMPE B,LOOP3Q ;IGNORE CHR?
TLNE B,SCRF ;DOES THIS CHR REQUIRE SPEC. ATT. BY SCAN?
XCT SPCTB(B) ;YES, HANDLE
SPCRT2: TLZ IFLG!NFLG!FLTFL ;CLEAR IDENT ,NUM
TLO SCFL!SFL ;SET SPC CHR,AHEAD
MOVE N,B ;PUT BITS IN N
JSR SPCSKP ;SKIP TO NEXT NON-BLANK CHR.
POPJ P,
LOOP3Q: JSP B,NULSKP
JRST LOOP3
JRST LOOP3A
NULSKP: JUMPN C,(B) ;IF NOT A NULL
NULSK1: SKIPE @INPNT ;ZERO WORD?
JRST LOOP3Z ;NO
MOVSI TAC,700 ;SKIP REST OF WORD
HRR TAC,INPNT ;AND PREPARE TO SKIP MORE
SKIPN 1(TAC)
AOJA TAC,.-1
MOVEM TAC,INPNT
LOOP3Z: ILDB C,INPNT ;NO, A NULL, GET NEXT
JUMPE C,NULSK1 ;SKIP NULLS IN TAIL OF WORD/TMW
JRST 2,@[20000,,1(B)] ;SET BIS & GO TO IDPB FOR LISTING
BSPCTB: PUSHJ P,RTBFND
JRST SPCRET
JRST LOOP3
^BROKCT:0
LBROK: HRRI B,LBCF!TP2F
TLZ B,SCRF
AOS BROKCT
POPJ P,
SPCTB: JRST DELT ;DELETE -- HANDLE
PUSHJ P,LSTLF ;HANDLE LINE FEED
JRST DQT ;HANDLE DOUBLE QUOTE
JRST SQT ;HANDLE SINGLE QUOTE
JRST EQLS ;HANDLE =
JRST LOOP3 ;SKIP SPACES
JFCL
PUSHJ P,NEWPAG
EMPS BSPCTB
^RTBFND:HRRI B,TP2F!RBCF
TLZ B,SCRF
SKIPN RTFLST ;ANY TO CHECK?
POPJ P, ;NO
PUSH P,N ;SAVE
MOVE N,BROKCT ;GET CURRENT COUNT
CAMN N,@RTFLST ;SAME?
JRST RFNDQ ;YES
SOS BROKCT ;NO, DECREMENT COUNT AND RETURN
POP P,N
POPJ P,
RFNDQ: PUSH P,L
MOVE L,RTFLST ;GET POINTER
MOVE N,FSTPNT ;PUT THIS ONE...
EXCH N,1(L) ;BACK ON FREE STRG.
MOVEM L,FSTPNT ;...
MOVEM N,RTFLST ;...
SOS BROKCT ;DECREMENT COUNT
POP P,L
POP P,N
JRST CPOPJ1 ;SKIP REUTRN
;HANDLE SOS LINE NUMBERS, PAGE MARKS.
LNUM: JSR SLNUM
JRST LOOP3
;WE GET HERE AND WE'VE IDPB'D INTO LSTPNT
^SLNUM: 0 ;SKIP LINE NUMBERS OR PAGE MARKS
CAIGE C,60 ;NUMBER?
JRST POPMK ;NO. THIS MUST BE A PAGE MARK
LNMC: MOVE C,@INPNT
MOVEM C,TLBLK
MOVEM C,SVLNUM
AOS INPNT ;SKIP LINE NUM WD
SKIPL @INPNT ;SEE IF WE RAN OFF BUFFER (RUBOUT WD WILL BE NEG)
JRST .+3 ;STILL IN BUFFER
PUSHJ P,INP ;GET NEXT BUFFER
IBP INPNT ;AND SKIP TAB
MOVEI C,0
DPB C,LSTPNT ;NULL OUT THAT SPURIOUS DIGIT
JRST @SLNUM
POPMK: MOVE C,[ASCID/ /]
CAME C,@INPNT ;PAGE MARK?
JRST LNMC ;NO
AOS INPNT ;SKIP FIRST PAGE MARK WD
SKIPGE @INPNT
PUSHJ P,INP ;READ ANOTHER BUFFER IF NEEDED
AOS INPNT ;SKIP SECOND PAGE MARK WD
MOVSI C,440700
HLLM C,INPNT
TRNE LDEV ;MAKE SURE THERE IS A LIST DEV
SKIPN XPNDSW ;AND THAT WE HAVE NOT SAID XLIST
TDZA C,C
MOVEI C,14 ;IN THAT CASE WE WILL MAKE A PAGE HEADING
DPB C,LSTPNT ;NULL (OR FF) OUT THAT SPACE.
PUSH P,SLNUM ;PREPARE TO RETURN
^NEWPAG:SKIPL AHED ;DON'T UPDATE THESE CELLS IF TEXT IS FROM MACRO
JRST LSTFRC
SETZM INLINE
AOS PGNM
SETZM SPGNM
JRST LSTFRC
NOLD: DELHN
SKIPL B,CTAB(C)
JRST NOLT+1
JRST @NOLT
DELT: DELHN
JRST AHED
^DELTAB:PUSHJ P,INPDT ;GET NEXT BUFFER (SOMETIMES DOES: IBP LSTPNT)
PUSHJ P,GETARG ;GO TO MACRO ARGUMENT
POP M,INPNT ;LEAVE ARGUMENT
PUSHJ P,LVMAC ;LEAVE MACRO
PUSHJ P,LVREP ;LEAVE REPEAT
PUSHJ P,LVFORL ;LEAVE NUMERIC FOR
PUSHJ P,LVFORI ;LEAVE "IN" FOR
PUSHJ P,EFORSH ;LEAVE "E" FOR
DEFINE QUOT ' (M)
< MOVEI L,1
SETZB N,NA
QP'M: ILDB C,INPNT
QQ'M: IDPB C,LSTPNT
QT'M: XCT AHED
JRST [JSR SLNUM
JRST QP'M]
JUMPE C,QN'M
MOVE B,CTAB(C)
TLNE B,SCRF
XCT SCQT'M(B)
QU'M:
IFE M,< TRZN C,100
TRZA C,40
TRO C,40>
LSH N,6+M
OR N,C
JRST QP'M
BSCQT'M:PUSHJ P,RTBFND
JRST QU'M
JRST QP'M
QN'M: JSP B,NULSKP
JRST QP'M
JRST QQ'M
>
SCQT1: JRST DH1
PUSHJ P,LSTLF
JRST SCR1
JFCL
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSCQT1
SCQT0: JRST DH0
PUSHJ P,LSTLF
JFCL
JRST SCR0
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSCQT0
DQT: QUOT(1)
DEFINE QUOTS ' (A)
<SCR'A: JSR SPCSKP
TLO SFL!NFLG
TLZ SCFL!IFLG
POPJ P,
DH'A: DELHN
JRST QT'A
>
QUOTS(1)
SQT: QUOT(0)
QUOTS(0)
NOLB: JRST NOLD
PUSHJ P,LSTLF
JFCL
JFCL
MOVE B,CTAB+"_" ;MAKE = LOOK LIKE _ AFTER SYMS
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BNOLB
BNOLB: PUSHJ P,RTBFND
JRST NOLT+1
ILDB C,INPNT
IDPB C,LSTPNT
SKIPL B,CTAB(C)
JRST NOLT+1
JRST @NOLT
BSH: TRNE RWARN2
ERROR [ASCIZ/INCORRECT DIGITS FOR THIS RADIX/]
PUSH P,N ;SAVE THE NUMBER WE HAVE SO FAR
PUSH P,SRAD ;CONVERT RADIX FOR NUMBERS TO =10
PUSH P,RTEST
MOVE N,[IMULI N,=10]
MOVEM N,SRAD
MOVE N,CTAB+"0"
ADDI N,12
MOVEM N,RTEST
MOVEI N,1(P)
BLT N,4(P) ;SAVE 0,1,2,3 ON STACK
ADD P,[4,,4]
TDO [OPFLG,,NOFXF] ;NO OPCODE LOOKUP, NO FIXUPS WANTED
PUSHJ P,SCANS ;EVALUATE ARGUMENT FOLLOWING THE B
TLNN UNDF!ESPF
TRNE NA,17
PUSHJ P,BSH1
MOVSI NA,-3(P) ;RESTORE ACS
BLT NA,3
SUB P,[4,,4]
MOVN NA,N ;GET THE SHIFT FACTOR
POP P,RTEST
POP P,SRAD
POP P,N ;THE ORIGINAL NUMBER
LSH N,=35(NA)
JRST NONM1
BSH1: ERROR [ASCIZ/Undefined B-Shift argument - taken as 0/]
MOVEI N,0
POPJ P,
; LEAVE MACRO, REPEAT, LVMAC,LVREP,GETARG
LVMAC: POP M,C ;GET OLD MTBPNT
JUMPE C,LVNO ;NO ARGS?
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
SKIPA
LVNO: SUB M,[1(1)]
POP M,INPNT ;SET SCAN POINTER BACK
POP M,INPNTP
;THIS IS SUPPOSED TO ADD A CLOSE CHARACTER AFTER THE MACRO EXPANSION
;UNFORTUNATELY, IT ALSO CAUSES THE CLOSE CHARACTER TO BE UNDERLINED.
MOVEI C,IFN STANSW,<"";>"^" ;INDICATE END OF MACRO ON LISTING
DPB C,LSTPNT ;STUFF A BYTE
IBP LSTPNT ;ACCOUNT FOR THE CLOSING CHARACTER
POP M,C ;RESTORE CHR. SIZE FOR LISTING
DPB C,[POINT 6,LSTPNT,11]
HRRZM C,XPNDSW
HLRZM C,INMCSW
POP M,C
MOVEM C,AHED
MOVEM C,LOOP6
SKIPE UNDLNS ;UNDERLINING?
SKIPE NOEXP ;NO EXPAND?
JRST ARNMC ;NO
SKIPN INMCSW ;IN A MACRO?
JRST ARNMC ;YES
HRR C,LSTPNT
ADDI C,TLBLK-MBLK ;GO BACK TO NORMAL POINTER
HRRM C,LSTPNT
ARNMC: POP M,C ;GET CHR.
JRST CPOPJ1 ;SKIP NEXT ILDB
GETARG: ILDB C,INPNT ;GET ARG #
ADD C,(M) ;GET POINTER
PUSH M,INPNT ;SAVE OLD PNTR.
MOVE C,(C)
MOVEM C,INPNT
POPJ P,
LVREP: SOSG -1(M) ;DECREMENT COUNT
JRST LRDON ;DONE
MOVE C,(M) ;GET...
HRLI C,440700 ;POINTER
MOVEM C,INPNT
POPJ P,
LRDON: POP M,C ;GET POINTER
SUB M,[1(1)]
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
ALDON: PUSHJ P,LSTCHK ;A GOOD PLACE TO CATCH LOSSAGE FROM MOBY LINES
POP M,INPNT ;RESTORE SCAN POINTER
POP M,INPNTP
POP M,C ;RESTORE...
DPB C,[POINT 6,LSTPNT,11] ;LISTING
HRRZM C,XPNDSW
HLRZM C,INMCSW
POP M,C
MOVEM C,AHED ;RESTORE LINE NUM SKIPPING
MOVEM C,LOOP6
SKIPE UNDLNS ;UNDERLINING?
SKIPE NOEXP ;NO EXPAND?
POPJ P,
SKIPN INMCSW ;IN A MACRO?
POPJ P,
HRR C,LSTPNT
ADDI C,TLBLK-MBLK
HRRM C,LSTPNT
POPJ P,
; LVFORL, LVFORI, EFORSH
LVFORL: MOVE B,-4(M) ;GET INCREMENT
ADDB B,-2(M) ;ADD NUM
SKIPG -4(M) ;NEG INCREMENT?
JRST NTST ;YES
CAMLE B,-3(M) ;DONE?
JRST LFDON ;YES
NLFD: MOVE C,(M) ;GET ARG POINTER
ADD C,[XWD 440700,2]
PUSHJ P,BKSLSH ;CON TO ASCII
EDEPO (B,C,2) ;DEPOSIT END OF ARG
MOVE B,-1(M) ;GET START
ADD B,[XWD 440700,2]
MOVEM B,INPNT
JRST LSTCHK
NTST: CAML B,-3(M) ;DONE? (NEGATIVE INCREMENT)
JRST NLFD ;NO
LFDON: HRRZ C,-1(M) ;GET START OF THROW-AWAY
SUB M,[5(5)]
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
JRST ALDON
LVFORI: MOVE B,(M) ;GET ARG POINTER
MOVE B,1(B) ;GET POINTER
ILDB C,B ;GET FIRST CHR. OF SECOND ARG
CAIE C,177 ;IS IT DELETE?
JRST IFORSH ;NO, GET NEXT ARG SETUP
SUB M,[2(2)] ;YES, NO MORE ITERATIONS
POP M,C ;GET START OF THROW-AWAY
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
JRST ALDON
^EFORSH:MOVE B,(M) ;GET ARG POINTER
ILDB C,1(B) ;GET NEXT CHR.
MOVE B,(B) ;GET FIRST ARG POINTER
IDPB C,B ;DEPOSIT CHR.
CAIN C,177 ;DONE?
JRST DYES ;YES
MOVE B,-1(M) ;GET TEXT POINTER
MOVEM B,INPNT ;DEPOSIT
JRST LSTCHK
DYES: POP M,C ;GET STRT OF REMOVABLE AREA
SUBI C,2 ;ADJUST
SUB M,[1,,1] ;ADJUST STACK
POP M,B ;END OF REMOVABLE AREA
PUSHJ P,MACRET
JRST ALDON ;
SUBTTL SCAN1,SCNTIL, SCANM
^SCAN1: TLZE SFL ;AHEAD?
JRST S1PT ;YES
^SCAN1A:MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM
LOOP4: ILDB C,INPNT ;GET CHR.
LOOP4A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING
^LOOP6: TDNE L,@INPNT ;LINE NUM?
JRST [JSR SLNUM
JRST LOOP4]
SKIPN B,CTAB(C) ;GET BITS, NULL CHR?
JRST LOOP4Q ;YES, NULL CHR.
S1PT: TLNE B,SCRF ;SPECIAL HANDLING?
XCT SC1T(B) ;YES, HANDLE
POPJ P,
LOOP4Q: JSP B,NULSKP
JRST LOOP4
JRST LOOP4A
SC1T: JRST SC1DH
PUSHJ P,LSTLF
JFCL
JFCL
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSC1T
BSC1T: PUSHJ P,RTBFND
POPJ P,
JRST LOOP4
SC1DH: DELHN
JRST LOOP6
^SCNTIL:TLZE SFL ;AHEAD?
JRST LOPP3 ;YES
LOPP1: ILDB C,INPNT ;GET CHR.
LOPP1A: IDPB C,LSTPNT ;DEPOSIT
LOPP2: SKIPN B,CTAB(C) ;GET BITS
JRST LOPP1Q ;NULL CHR
LOPP3: TLNE B,SCRF ;SPECIAL?
XCT STTB(B) ;YES
MOVSI B,777777-COMBTS ;WATCH US SKIP COMMENTS FAST
MOVE TAC,INPNT
LOP69:
REPEAT 5,< ILDB C,TAC
IDPB C,LSTPNT
TDNN B,CTAB(C)
JRST LOP105 >
JRST LOP69
LOP105: MOVEM TAC,INPNT
JRST LOPP2
LOPP1Q: JSP B,NULSKP
JRST LOPP1
JRST LOPP1A
STTB: JRST STDH ;DELETE
JRST LSTLF ;LINE FEED, FORCE LISTING AND RETURN
JFCL
JFCL
JFCL
JFCL
JFCL
JRST NEWPAG ;FORM FEED, ADVANCE PAGE AND RETURN
EMPS BSTTB
BSTTB: PUSHJ P,RTBFND
JRST LOPP1
JRST LOPP1
STDH: DELHN
JRST LOPP2
^SLURP: PUSH P,BROKCT ;ROUTINE TO EAT TEXT UP TO MATCHING BROKET
SETZM BROKCT
JSP TAC,SLRP0
SOSL BROKCT
JRST SLRP1
POP P,TAC
ADDM TAC,BROKCT
POPJ P,
^SLURPC:MOVE TAC,CTAB(C) ;EATS TEXT UP TO MATCHING CHAR
TLNN TAC,777777-COMBTS
TLNN TAC,SCRF
JRST .+3
ERROR [ASCIZ /ILLEGAL DELIMETER/]
POPJ P,
PUSH P,TAC
HRLOI TAC,SCRF ;-1 INDEX MEANS EXIT VIA SLRPX
MOVEM TAC,CTAB(C)
TLZ SFL
JSP TAC,SLRP0
PUSHJ P,RTBFND
JRST SLRP1
JRST SLRP1
SLRP0: HRRM TAC,SRBINS
MOVEI L,1 ;FOR LINE NUMBER TEST
TLZE SFL
JRST SLRP2
SLRP1: ILDB C,INPNT
SLRP1A: IDPB C,LSTPNT
SLRP2: XCT AHED ;TEST FOR LINE NUMBER IF APPROPRIATE
JRST [JSR SLNUM ;FLUSH LINE NUMBER (SPECIAL)
JRST SLRP1]
SKIPN B,CTAB(C)
JRST SLRPN
SLRP3: TLNE B,SCRF
XCT SLTB(B)
MOVSI B,777777-COMBTS ;PREPARE TO IGNORE ALMOST EVERYTHING
MOVE TAC,INPNT
SLRP4:
REPEAT 5,<
ILDB C,TAC
IDPB C,LSTPNT
TDNN B,CTAB(C)
JRST SLRP5
>
JRST SLRP4
SLRP5: MOVEM TAC,INPNT
JRST SLRP2
;XCT TABLE FOR SPECIAL CHARACTER DISPATCH
JRST SLRPX ;EXIT FROM SLURPC RESTORE CTAB
SLTB: JRST SLDH
JRST [PUSHJ P,LSTLF ;FORCE LISTING NOW
JRST SLRP1]
REPEAT 7-2,<JFCL>
PUSHJ P,NEWPAG
AOS BROKCT
SRBINS: JRST .-. ;ADDRESS GETS CLOBBERED
SLRPN: JSP B,NULSKP
JRST SLRP1
JRST SLRP1A
SLDH: DELHN
JRST SLRP2
SLRPX: POP P,B
MOVEM B,CTAB(C)
POPJ P,
;SCANM HERE FOR SCAN IF MACROS ARE TO BE EXPANDED
;SCANM1 alternate entry from DSCANM
^SCANM: PUSHJ P,SCAN
TLNN IFLG ;IDENTIFIER?
POPJ P, ;NO
SCANM1: MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
SKIPN TAC,MACRT(NA) ;GET START OF MACRO TABLE CHAIN
POPJ P, ;NONE THERE.
SRC1(L,TAC,SCNMF,<POPJ P,>) ;SEARCH FOR THIS IDENT AS A MACRO
SCNMF: MOVEI NA,(TAC) ;NA=SYMBOL BLOCK FOR THIS MACRO
SKIPN N,3(NA) ;ANY ARGS?
JRST NOAG ;NO
JUMPL N,SCNMPO ;JUMP IF MACRO "PSEUDO OP" (IFs, ".", .FNAM1, ETC)
PUSH P,NA ;SAVE POINTER TO MACRO SYMBOL ENTRY
PUSH P,MTBPNT ;SAVE ARGUMENT POINTER
PUSHJ P,ARGIN ;GET ARGUMENTS
JUMPN C,.+2
IBP LSTPNT
POP P,N ;GET POINTER TO THE ARGUMENT LIST
HRRZM NA,MTBPNT ;DEPOSIT NEW POINTER TO MACRO FREE SPACE
POP P,NA ;RESTORE POINTER TO MACRO SYMBOL ENTRY
NOAG: SKIPE XCRFSW ;CREF IN PROGRESS RIGHT NOW?
JRST [CAIN NA,%IOWD ;YES. IS THE IOWD PREDEFINED MACRO?
CREF7 5,(NA) ;YES. IOWD. CREF IT AS AN OPCODE/PSEUDO-OP
CAIE NA,%IOWD
CREF6 5,(NA) ;OTHERWISE CREF IT AS A MACRO
JRST .+1]
PUSH M,C ;SAVE CHR.
; TRNE B,LBCF!RBCF ;DID WE FUCK UP BROKCT?
; JRST [ TRNE B,LBCF
; SOSA BROKCT
; AOS BROKCT
; JRST .+1]
PUSH M,AHED ;SAVE STATE OF LINE NUMBER LOOKING FOR
LDB C,[POINT 6,LSTPNT,11] ;SAVE STATE...
HRL C,INMCSW ;IN MACRO &...
PUSH M,C ;INSIDE MACRO FLAG,,STATE OF LISTING
PSHPNT (C) ;SAVE SCAN POINTER, ETC
PUSH M,MTBPNT
PUSH M,N ;DEPOSIT ARG POINTER
TLZ SFL ;CLEAR "SCAN AHEAD"
IFN STANSW,< MOVEI N,"";>MOVEI N,"^"
DPB N,LSTPNT ;ERASE LAST CHR IN LISTING
MOVEI N,
SKIPE NOEXP ;NO MACRO EXPAND?
DPB N,[POINT 6,LSTPNT,11] ;YES,DISCONTINUE LISTING
SKIPE NOEXP
SETZM XPNDSW
SETZM INMCSW ;FLAG WE ARE INSIDE MACRO EXPANSION
MOVE N,4(NA) ;GET TEXT POINTER
HRLI N,700 ;MAKE INTO BYTE POINTER
MOVEM N,INPNT ;SET MACRO-INPNT (DISTINCT FROM FILE-INPNT)
MOVSI N,(<SKIPA>)
MOVEM N,AHED ;AVOID SKIPING...
MOVEM N,LOOP6 ;LINE NUMBERS
SKIPN NOEXP ;NO EXPAND?
SKIPN UNDLNS ;UNDERLINE?
JRST SCANM ;NO
HRRZ N,LSTPNT ;GET LIST. POINTER
CAIL N,TLBLK ;ALREADY CHANGED?
SUBI N,TLBLK-MBLK ;NO,CHANGE IT
HRRM N,LSTPNT
TRO MACUNF ;SET BIT - MACRO UNDERSCORE
JRST SCANM
SCNMPO: TLNE N,1 ;MACRO PSEUDO OP. EMIT TO CREF?
SKIPN XCRFSW ;YES. BUT ARE WE DOING CREF?
JRST @4(NA) ;NO TO ONE OF THE ABOVE, PROCESS PSEUDO-OP
CREF7 5,(NA) ;EMIT TO CREF AND PROCESS
JRST @4(NA)
^SCNMPT:TLZ IFLG ;HERE FOR "." AND "$." FAKE SCANS INTO CALLING
POPJ P, ;SPCCHK ...ALSO .FNAM1,.FNAM2
;ARITHMETIC IFS, IFIDN
^REPSW: 0 ;0 FOR CONDITIONALS, -1 FOR REPEATS
Q%SV: 0
^Q%IF: DPB N,[POINT 3,Q%T,8] ;DEPOSIT TEST CONDITION
MOVEI N,1(P)
BLT N,4(P) ;SAVE AC'S
ADD P,[4,,4]
TDO [OPFLG,,NOFXF]
PUSHJ P,MEVAL ;GET VALUE
TLNN UNDF!ESPF
TRNE NA,17 ;CHECK FOR DEFINED
PUSHJ P,IFER ;ERROR - ARGUMENT IS UNDEFINED.
MOVSI NA,-3(P)
BLT NA,3 ;RESTORE AC'S
SUB P,[4,,4]
Q%T: SKIP N ;***INSTRUCTION IS CLOBBERED***
TDZA N,N ;N_0 AND SKIP.
MOVEI N,1 ;N_1
SETZM REPSW ;DO NOT INSERT CR LF AT END OF CONDITIONAL
PUSHJ P,REP ;DO THE REPEAT. N IS THE REPEAT COUNT
JRST SCANM
IFER: ERROR [ASCIZ /UNDEFINED IF ARGUMENT - TAKEN AS 0/]
MOVEI N,0
POPJ P,
^Q%IFD: HRREM N,Q%SV ;SAVE "VALUE" (0 OR -1)
JSR LGET ;GET THE {
MOVE NA,MTBPNT ;MAKE POINTER
HRLI NA,440700 ;...
PUSHJ P,SARGIN ;READ IN FIRST ARG.
MOVEI N,0 ;FIVE MORE ZEROES TO END THE FIRST ARG
REPEAT 5,<LEG IDPB N,NA>
HRRZ N,NA ;N_STARTING ADDRESS OF SECOND ARG.
HRLI NA,440700 ;MAKE POINTER
JSR LGET ;GET THE {
PUSHJ P,SARGIN ;READ IN SECOND ARG
MOVEI TAC,0 ;SUPPLY EXTRA ZEROS
REPEAT 5,<LEG IDPB TAC,NA>
HRRZ NA,NA ;ENDING ADDRESS OF SECOND ARG.
SUB NA,N
ADD NA,MTBPNT
CAME NA,N ;SAME LENGTH?
JRST FLS ;NO. - FALSE
MOVE NA,MTBPNT ;GET POINTER
MOVE PN,N ;SAVE END
Q%LOP: MOVE TAC,(N) ;GET WORD
XOR TAC,(NA) ;ARE THEY THE SAME? TAC_0 IF SO.
TRZ TAC,1 ;(IGNORE BIT 35 IN COMPARE)
JUMPN TAC,FLS ;JUMP IF DIFFERENT. (FALSE)
ADDI NA,1
CAMGE NA,PN ;DONE?
AOJA N,Q%LOP ;NO. ADVANCE N AND LOOP.
TR: SETCMM Q%SV ;TRUE - COMPLEMENT FLAG
FLS: AOS N,Q%SV ;FALSE. GET VALUE (N_0 OR 1)
SETZM REPSW ;NO CRLF AT END
PUSHJ P,REP ;DO IT
JRST SCANM
; IFDEF, IFAVL, IFMAC AND IFOP
QERR: ERROR [ASCIZ/NOT IDENT AFTER IFDEF,IFAVL, ETC. /]
JRST SCANM
^QIF%D: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVM PN,PN
SKIPN PN,SYMTAB(PN) ;GET START OF CHAIN
JRST QICOM ;NONE
SRC1 (L,PN,DFND,JRST QICOM)
DFND: MOVE N,2(PN) ;GET FLAGS
TLNE N,DEFFL ;DEFINED ANYWHERE?
JRST QICOM ;NO
JRST TR
^QIF%A: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVM PN,PN
SKIPN PN,SYMTAB(PN) ;GET START
JRST QICOM ;NONE
SRC1 (L,PN,AFND,JRST QICOM)
AFND: MOVE N,2(PN) ;GET FLAGS
TLNN N,DEFFL ;DEFINED AT ALL?
TDNN N,BLOCK ;YES. DEFINED IN THIS BLOCK?
JRST QICOM ;NO
JRST TR ;YES
QICOM: MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVM PN,PN
SKIPN PN,MACRT(PN) ;GET START OF MACRO TABLE
JRST QIOP ;NONE
SRC1 (L,PN,TR,JRST QIOP)
QIOP: MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVM PN,PN
SKIPN PN,OPCDS(PN) ;GET START
JRST FLS ;NONE
SRC2 (L,PN,TR)
JRST FLS
;IFOP IFNOP ;REG 3-15-74
^QIF%O: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
JRST QIOP
;IFMAC IFNMAC
^QIF%M: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVM PN,PN
SKIPN PN,MACRT(PN) ;GET START
JRST FLS ;NONE
SRC2 (L,PN,TR)
JRST FLS ;NONE
; .INSERT
;FORMAT IS .INSERT DEV:FILE.EXT[PRJ,PRG]
;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!!
^%INSER:
MOVE N,FILSTP ;GET FILE-STACK POINTER
CAIL N,FILSTP ;POINTS BEYOND END OF FILE-STACK?
JRST INSRET ;YES. TOO MANY NESTED INSERTS
NOTNX,< HRLI N,LFDEV ;SOURCE,,DESTINATION IN N.
MOVEI NA,(N)
BLT N,5(NA) ;STORE PERMANENT FILE PARAMETERS (DEV,FIL,EXT,PPN)
MOVE N,LFDEV ;GET DEVICE NAME OF PRESENT DEV
DEVCHR N, ;GET DEC-STYLE CHARACTERISTICS
TLNN N,200000 ;MUST BE DSK.
JRST INSRED ;LOSE.
>;NOTNX ;SO FAR I'M HAPPY. LET'S PARSE A FILE NAME.
TNX,< MOVE NA,JFNTBL ;INPUT JFN PLUS FLAGS
MOVEM NA,(N) ;STACK IT
JUMPGE NA,INSRED ;NON-DISK DEVICE. >;TNX
MOVEM 16,TSV+16 ;SAVE AC'S DURING FILE NAME SCAN
MOVEI 16,TSV
BLT 16,TSV+15
MOVE 16,TSV+16 ;RESTORE 16 NOW (MACRO PDL)
PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER.
MOVE N,[PUSHJ P,AFSCAN]
MOVEM N,FNREAD
ITS,< PUSH P,LIMBO
SETZM LIMBO >
NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE
SETZB 5,4 ;NO ASSUMPTION ABOUT FILE NAME OR PPN >;NOTNX
NOITS,< MOVEI 3,0 ;NO ASSUMPTION ABOUT EXTENSION >;NOITS
ITS,< MOVSI 3,360000 ;USE "GREATER THAN" AS EXTENSION >;ITS
;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13.
;0 IS SETUP CORRECTLY
;1,2,4,5,6,12,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC)
;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN
;7 (CP) IS USED AS THE COROUTINE PDL
SETZM INSRFG# ;FLAG FOR SUCESSFUL SCAN
JSR NOTNX,<GETFIL;> TGETF ;GET A FILE NAME
SETOM INSRFG ;CAN'T PARSE FILE NAME.
MOVEM 16,TSV+16 ;SAVE M SINCE SCANNER MAY BE INSIDE A MACRO
ITS,< POP P,LIMBO >
POP P,FNREAD
TLO SFL ;LETS SEE THE CHARACTER BY WHICH WE TERMINATED
SKIPE INSRFG
JRST INSREF ;SCAN ERROR.
TRZ NOFXF
INSR1: PUSHJ P,SCAN1
TLNN B,CRFG!LNFD!RBRF ;SCAN TO NEXT LF OR RIGHT BRACE
JRST INSR1
MOVEM 16,TSV+16 ;SAVE M SINCE SCANNER MAY BE INSIDE A MACRO
TLNE B,RBRF ;BRACE?
JRST ISWITC ;YES (AVOID FORM FEED, ETC)
TLNN B,LNFD ;LINE FEED YET
PUSHJ P,SCNTIL
MOVEI 16,1
MOVEM 16,LNCNT ;ARRANGE FOR NEXT LF TO MAKE NEW PAGE
ISWITC: MOVE 16,@INPNTP ;GET FILE-INPNT (INPUT BYTE POINTER)
SUB 16,INPOFS ;BYTE-OFFSET
MOVEM 16,@INPNTP ;SAVE BYTE-OFFSET (MAY CLOBBER REAL INPNT)
MOVE 16,INPNT ;GET PRESENT INPNT (NEEDED IF CALLED FROM MACRO)
MOVE 15,FILSTP ;FILE-STACK POINTER
MOVEM 16,NOTNX,<3(15);> 1(15) ;SAVE OLD-INPNT
HRLZ 16,PGNM ;GET PAGE NUMBER
HRR 16,IRECN ;GET RECORD NUMBER
MOVEM 16,NOTNX,<5(15);> 2(15) ;SAVE RECORD NUMBER AND PAGE NUMBER
HRRZ 16,INLINE
IFN STANSW,< HRL 16,TVFILE >;SAVE STATE OF TVFILE
MOVEM 16,NOTNX,<6(15);> 3(15)
MOVE 16,INPNTP ;GET POINTER TO FILE-INPNT
MOVEM 16,NOTNX,<7(15);> 4(15) ;SAVE ON FILE-STACK
ADDI 15,FILSTL ;PUSH FILE-STACK POINTER PAST THIS ENTRY
MOVEM 15,FILSTP ;SAVE IT.
AOS FILSTC ;INCREMENT FILE-STACK DEPTH
MOVEI 6,INSNOF ;SET UP FOR FAILURE FROM INITIT
MOVEM 6,INITL ;(ICK!)
MOVEI 6,2 ;SET FOR DEVICE 2 (INPUT FILE)
JSR INITIT ;SWITCH TO ALTERNATE INPUT FILE.
NOTNX,< MOVEI NA,IBUFR1 ;ADDRESS OF THE FIRST BUFFER
TLO NA,400000
MOVEM NA,IDB ;SET UP BUFFER >;NOTNX
SETZM IRECN ;SET RECORD COUNT
MOVE 16,[TSV+1,,1]
BLT 16,16 ;RESTORE OLD AC'S (0 AND P ARE OK)
SETZM PGNM ;SETUP LINE AND PAGE STUFF
AOS PGNM
SETZM INLINE
SETZM SPGNM
SETZM TLBLK ;FLUSH SOS LINE #
SETZM SVLNUM ;"
PUSHJ P,TVSKIP ;SETUP TO READ FIRST RECORD, AND RETURN
JRST SCANM ;CONTINUE MACRO-SCAN
INSREF: ERROR [ASCIZ/CAN'T PARSE FILE NAME/]
MOVE 16,[TSV+1,,1] ;(PRESENT CONTENTS OF 0 ARE RIGHT)
BLT 16,16 ;RESTORE AC'S (EXCEPT P)
JRST SCANM ;RETURN AND DON'T SWITCH.
INSRET: ERROR [ASCIZ/.INSERT NESTED TOO DEEP/]
JRST SCANM
INSRED: ERROR [ASCIZ/MUST SWITCH FROM DSK:/]
JRST SCANM
INSNOF: FATAL [ASCIZ/FATAL: CANNOT LOCATE INSERTED FILE/]
SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP
;SCANS GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED AND
; SYMBOLS ARE TO BE LOOKED UP
;SCANS1 is alternate entry point to SCANS from DSCANS
^SCANS: PUSHJ P,SCANM ;ANY MACRO FOUND WILL BE EXPANDED.
SCANS1: TLNN IFLG ;IDENT?
JRST SPCCHK ;NO, SPC CHR.
TLNN OPFLG ;HAS AN OPCODE BEEN SEEN?
SKIPN PN,OPCDS(NA) ;NO. CHECK OPCODE TABLE GET START OF CHAIN
JRST PT1 ;NONE
SRC2 (L,PN,PT2)
PT1: SKIPN TAC,SYMTAB(NA)
JRST PT4 ;NONE THERE AT ALL
CAMN L,(TAC)
JRST PT69 ;FIRST SYM IN LIST. DON'T MOVE IT.
SR: SKIPN PN,1(TAC)
JRST PT4 ;END OF LIST
CAMN L,(PN) ;IF IT MATCHES
JRST PT3
SKIPN TAC,1(PN) ;ELSE TRY NEXT
JRST PT4 ;HERE IF SYM NOT FOUND
CAME L,(TAC) ;SEE US PLAY LEAPFROG WITH AC'S
JRST SR ;KEEP LOOKING
EXCH TAC,PN ;STRAIGHTEN OUT AC'S
;HERE PN IS SYM FOUND, AND TAC IS PREVIOUS SYM IN LIST
;SYM IS MOVED TO FRONT OF LIST TO FIND "POPULAR" SYMS FAST
PT3: MOVE N,2(PN)
TDNN N,BLOCK ;RIGHT BLOCK?
JRST PT4 ;NO - MUST NOT BE THERE
EXCH N,1(PN) ;NEXT GUY
EXCH N,1(TAC) ;DELINK & GET CURRENT (SAME AS PN)
EXCH N,SYMTAB(NA) ;SWAP CURRENT WITH FIRST
EXCH N,1(PN) ;AND POINT CURRENT AT REST OF LIST (RESTORING N)
PT69R: SKIPE XCRFSW
CREF6 1,(PN)
PT3B: TRNE B,SHRPF!UDARF ;# OR ^ NEXT?
JRST VRHN ;YES
PT3A: TLNE N,DEFFL ;DEFINED?
JRST NODF ;NO
TLON N,REFBIT
JRST [TLZ N,SUPBIT ;NO LONGER SUPPRESSED
MOVEM N,2(PN) ;STORE NEW FLAGS
JRST .+1]
MOVE N,3(PN) ;YES,GET VALUE ...
MOVE NA,4(PN) ;....
POPJ P,
NODF: MOVE N,PN ;NO DEFINITION. VALUE IS POINTER
HLLZ NA,2(PN)
POPJ P,
PT1X: TRNN B,SHRPF ;TERMINATES WITH SHARP?
TRNE B,TP2F ;NO. UPARROW?
JRST PT1 ;TERMINATES WITH ^ (OR TILDE) OR #
JRST PT2X ;TERMINATES WITH DOWN-ARROW (OR ?) ASSUME THIS IS OPCODE
;HERE FROM MEVAL&DEFN WHEN SYMBOL WAS FOUND AS AN OPCODE,
; BUT WE WANT TO DEFINE IT AS A LABEL (PARAMETER, ETC.)
^RESCN: MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
JRST PT1
;HERE WHEN AN OPCODE IS FOUND
PT2: TRNE B,SHRPF!UDARF ;TERMINATES WITH # OR ^
JRST PT1X ;YES. IT MIGHT NOT BE AN OPCODE!
PT2X: TLO SOPF ;OPCODE FOUND
^OPVAL: MOVEI NA, ;ZERO NA
HLLZ N,1(PN) ;GET FLAGS (VALUE)
TLNN N,30 ;REGULAR OPCODE?
POPJ P, ;YES, RETURN IT
NOITS,< TLZE N,10 ;CALLI?
JRST CALLOP ;YES. >
JUMPL N,PSOP ;PSEUDO-OP?
MOVE N,2(PN) ;THIS IS AN OPDEF
TLON N,REFBIT ;MARK AS REFERENCED IN FLAG WORD
JRST [TLZ N,SUPBIT ;AND NOT SUPPRESSED.
MOVEM N,2(PN) ;(ONLY WRITE IF IT NEEDS TO.)
JRST .+1]
MOVE N,3(PN) ;NO, GET VALUE
MOVE NA,4(PN) ;AND VALUE FLAGS
POPJ P, ;RETURN
PSOP: TLO PSOPF ;PSEUDO-OP SEEN
MOVE NA,2(PN) ;GET PSEUDO-OP ROUTINE ADDRESS
MOVE N,3(PN) ;GET VALUE
POPJ P,
NOITS,<
CALLOP:
IFN STANSW,< ROT N,15
CAML N,UCLDLN ;SMALLER THAN STANFORD SPECIAL CALLIS?
ADD N,SCLOFF ;NO. ADD OFFSET TO MAKE CALLI 400000+ >
IFE STANSW,< ASH N,-27 ;SIGN EXTEND CALLI NUMBER TO RIGHT SIDE >
HRLI N,(<CALLI>)
POPJ P,
>;NOITS
^MKNEW: PUSH P,N ;SAVE
PUSH P,NA
PUSH P,L
MOVE L,(PN) ;GET SIXBIT
MOVE N,L
IDIVI N,HASH ;HASH
MOVM NA,NA
PUSHJ P,PT4 ;MAKE A PLACE
POP P,L ;RESTORE
POP P,NA
POP P,N
POPJ P,
PT69: MOVEI PN,(TAC) ;UNSHUFFLE AC'S
MOVE N,2(PN)
TDNE N,BLOCK ;RIGHT BLOCK?
JRST PT69R ;YES
PT4: GFST PN,FSTPNT ;MAKE AN ENTRY FOR A NEW SYMBOL. GET SOME FREE STG.
SKIPE XCRFSW
CREF6 1,(PN)
MOVEM L,(PN) ;DEPOSIT SIXBIT
MOVE N,SYMTAB(NA) ;GET CURRENT POINTER
MOVEM PN,SYMTAB(NA) ;REPLACE WITH POINTER HERE
EXCH N,1(PN) ;POINT NEW TO OLD AND ...
MOVEM N,FSTPNT ;ADVANCE FREE STRG PNT.
SETZM 3(PN) ;NO FIXUPS YET
SETZM 4(PN) ;NO POLFIX'S YET
MOVSI N,DEFFL ;UNDEFINED
OR N,BLOCK ;GET BLOCK BIT
PT4A: TRNE B,SHRPF!UDARF ;# OR ^ NEXT?
JRST VARH ;YES
MOVEM N,2(PN) ;SET FLAGS
HLLZ NA,N
MOVEI N,(PN) ;VALUE IS POINTER
POPJ P,
MAKEXT: PUSHJ P,SCAN1A ;SKIP THE ^
MOVE L,(PN) ;RESTORE SIXBIT IN CASE LABEL
TLNN N,DEFFL
TLOA N,INTF!REFBIT ;CONSIDER THESE TO BE REFERENCES
TLO N,EXTF!REFBIT
POPJ P,
EXTH: PUSHJ P,MAKEXT ;FIRST OCCURANCE OF SYMBOL HAS ^ FOLLOWING
JRST PT4A
;HERE WHEN FIRST OCCURENCE OF SYMBOL HAS ^ OR # FOLLOWING.
VARH: TRNE B,UDARF ;# OR ^ ?
JRST EXTH ;WAS ^
PUSHJ P,SCAN1A ;PASS THE #
TRNE B,SHRPF ;IS NEXT ANOTHER #?
JRST EXTH ;YES. ## MEANS EXTERNAL
TLO N,VARF!UDSF!REFBIT ;SET # BIT. CONSIDER THIS TO BE A REFERENCE
MOVEM N,2(PN) ;& STORE
SKIPN XCRFSW
JRST VARH1 ;NOT DOING CREF
MOVEI NA,2 ;GIVE # TO CREF
SKIPE LISTSW
IDPB NA,CREFPT
VARH1: GFST NA,FSTPNT
MOVEM PN,(NA)
MOVE N,VARLST
MOVEM NA,VARLST
EXCH N,1(NA)
MOVEM N,FSTPNT
SETZM 2(NA) ;ONE WORD
HLLZ NA,2(PN) ;GET FLAGS
MOVE N,PN ;VALUE IS POINTER
POPJ P, ;RETURN
;HERE WHEN SYMBOL NAME HAS BEEN SEEN BEFORE, AND THIS TIME HAS # OR ^ FOLLOWING.
EXHN: PUSHJ P,MAKEXT
MOVEM N,2(PN)
JRST PT3B
VRHN: TLON N,REFBIT
MOVEM N,2(PN) ;CONSIDER THIS IS A REFERENCE
TRNE B,UDARF
JRST EXHN
PUSHJ P,SCAN1A
TRNE B,SHRPF ;## SEEN?
JRST EXHN ;MEANS EXTERNAL
SKIPN XCRFSW
JRST VRHN1 ;NOT DOING CREF
MOVEI NA,2
SKIPE LISTSW
IDPB NA,CREFPT
VRHN1: TLNN N,DEFFL
JRST PT3A ;ALREADY DEFINED, JUST LEAVE IT
TLOE N,UDSF!VARF ;TURN ON AND CHECK
JRST PT3P
MOVEM N,2(PN) ;SAVE FLAGS
GFST NA,FSTPNT ;GET FREE STORAGE
MOVEM PN,(NA) ;SAVE PNTR TO SYMBOL
MOVE N,VARLST
MOVEM NA,VARLST ;PUT ON VARIABLE LIST
EXCH N,1(NA)
MOVEM N,FSTPNT
SETZM 2(NA) ;MARK AS ONE WORD VARIABLE
SKIPA N,2(PN)
PT3P: MOVEM N,2(PN) ;SAVE FLAGS
JRST PT3A
SPCCHK: TLNN NFLG ;NUMBER?
TLNN N,LBRF ;NO. LEFT BRACKET, OR "." OR "$." KLUDGE?
POPJ P, ;NO
TLNN SCFL
JRST (N) ;NOT A SPECIAL CHAR; IT MUST BE "." "$."
;ALSO .FNAM1,.FNAM2
PUSH P,EFSPNT
MOVEM FS,EFSPNT
ADD P,[XWD 12,12]
JUMPGE P,PDLOV
MOVSI TAC,PCNT ;PUSH PCNT & +1...
HRRI TAC,-11(P) ; OPCNT & +1...
BLT TAC,-4(P) ;& WRD & +1
HRRZI TAC,-3(P)
BLT TAC,(P) ;SAVE AC'S
TLZ MLFT ;...0 TO 3
TRNN N,TP1F ;[ OR <?
JRST IRBO ;BROKET
;NO. SQUARE BRACKET - DO LITERALS
;HERE WE DO LITERALS
;LITNUL KNOWS WHAT'S PUSHED ON THE STACK!
GFST T,FSTPNT ;GET FREE STRG.
SETZM (T) ;ZERO COUNT
GFST (N,<1(T)>) ;GET NEXT
MOVEM N,2(T) ;DEPOSIT POINTER TO VALUE
MOVEM N,OPCNT ;SET CURRENT LOC. TO IN CORE &...
MOVEM N,PCNT ;HERE
MOVSI TAC,INCF ;AND TO "IN CORE"
MOVEM TAC,OPCNT+1 ;...
MOVEM TAC,PCNT+1 ;...
SETZM (N) ;ZERO REVERSE FIXUP POINTER FOR VALUE
SETZM 2(N) ;NO FLAGS
SETZM 3(N) ;NO BACK PNTR
MOVE TAC,1(N) ;GET POINTER TO REST OF FREE STRG
MOVEM TAC,FSTPNT ;& DEPOSIT
SETZM 3(T) ;NO FIXUPS YET
SETZM 4(T) ;...
PUSH P,LITFIL
NOTNX,< PUSH P,LITFIL+1
PUSH P,LITFIL+2 >;NOTNX
PUSH P,LITPG
PUSH P,LITLIN
PUSH P,LABLTP
PUSH P,LABLTC
PUSH P,N
PUSH P,T
SETZM LABLTP ;INIT FOR ANY LABELS...
SETZM LABLTC ;IN THIS LITTERAL
SKIPN T,TLBLK
HRRO T,INLINE
MOVEM T,LITLIN
MOVE T,PGNM
MOVEM T,LITPG
NOTNX,< MOVE T,[FILNM,,LITFIL]
BLT T,LITFIL+4 >;NOTNX
TNX,< MOVE T,JFNTBL ;JFN FOR CURRENT INPUT FILE
MOVEM T,LITFIL >;TNX
TCALL: ACALL ;CALL ASSEMBL
SKIPN WRD+1 ;EMPTY?
JRST LEMP ;YES
AOS @(P) ;COUNT # OF WORDS IN LIT.
AOS LABLTC
LEMCON: MOVE N,-1(P) ;GET POINTER TO VALUE
MOVE TAC,WRD
MOVEM TAC,3(N) ;SET VALUE...
MOVE TAC,WRD+1
MOVEM TAC,4(N) ;...
TRZE TRBF ;TERM BY ]?
JRST ANOBR ;YES
GFST T,FSTPNT ;GET FREE STRG.
MOVEM T,1(N) ;POINT TO HERE
MOVEM N,3(T) ;POINT BACK
MOVEM T,PCNT ;SET LOC...
MOVEM T,OPCNT ;COUNTERS
MOVE N,1(T) ;GET REST OF FREE STRG.
MOVEM N,FSTPNT ;SET FSTPNT
MOVEM T,-1(P) ;SET NEW POINTER
SETZM (T) ;ZERO REVERSE FIXUP POINTER
SETZM 2(T) ;NO FLAGS
JRST TCALL
ANOBR: SETZM 1(N) ;ZERO VALUE POINTER(NO MORE)
POP P,NA
MOVE T,LABLTP
HRLM T,2(NA) ;STORE PNTR TO LABELS
MOVE T,(NA) ;INVENT A CONSTANT HASH FCN FORMERLY: T,3(N)
IDIVI T,HASH
MOVMS FS
MOVE O,LITPNT(FS)
MOVEM NA,LITPNT(FS)
; PUSHJ P,LITCOM ;THIS MIGHT SAVE CORE, BUT IT WASTES LOTS OF TIME.
MOVEM O,1(NA)
MOVE PN,NA
LITNUL: MOVE T,NOTNX,<-13(P);> -11(P) ;GET OLD FLAGS
TDZ REFLAG
AND T,REFLAG
OR T ;RESTORE CERTAIN FLAGS
TDZ [XWD NFLG!SCFL!PSOPF!SOPF,TRBF]
TLO IFLG
SUB P,[1,,1]
POP P,LABLTC ;RESTORE OLD COUNT
POP P,LABLTP ;RESTORE OLD
POP P,LITLIN
POP P,LITPG
NOTNX,< POP P,LITFIL+2
POP P,LITFIL+1 >;NOTNX
POP P,LITFIL
HRLZI N,-2(P)
ADDI N,1
BLT N,3 ;RESTORE AC'S
MOVSI N,-11(P)
HRRI N,PCNT
BLT N,PCNT+5 ;RESTORE PCNT ETC.
SUB P,[XWD 12,12]
PUSHJ P,SCAN1 ;GET A PEEK AT NEXT (FOR CALLER)
TLO SFL ;BUT ONLY A PEEK
MOVSI NA,DEFFL
MOVE N,PN ;MARK AS UNDEFINED LABEL
POP P,EFSPNT
JUMPN N,.+3
MOVEI NA,
TLC IFLG!NFLG ;JUST GIVE 0 IF NULL
POPJ P,
LEMP: TRNN TRBF ;TERM BY > OR ]?
JRST TCALL ;NO
MOVE T,-1(P) ;PNTR TO VAL
MOVE N,FSTPNT
MOVEM N,1(T)
MOVEM T,FSTPNT ;RETURN UNUSED BLK
SKIPE N,3(T) ;GET LAST PNTR
JRST ANOBR ;FINISH IT OFF
ERROR [ASCIZ/NULL LITERAL/] ;OOPS
POP P,PN
MOVEM T,1(PN)
MOVEM PN,FSTPNT ;RETURN HEADER
MOVEI PN,
JRST LITNUL
;PROCESS "PREDEFINED SYMBOLS" $. . .FNAM1 .FNAM2
^SCAN.: MOVE N,DPCNT ;HERE FOR .
MOVE NA,DPCNT+1
TLO IFLG
POPJ P,
^SCAN$.:TLO IFLG ;HERE FOR $.
MOVE N,OPCNT
MOVE NA,OPCNT+1
TLNN NA,INCF
POPJ P, ;NOT IN LIT - EASY
GFST PN,FSTPNT ;IN LIT - KLUDGE UP A PSEUDO LITLAB
MOVEI T,
EXCH T,1(PN)
MOVEM T,FSTPNT
SETZM (PN) ;THIS WILL DISTINGUISH IT
SETZM 3(PN)
SETZM 4(PN)
MOVSI T,DEFFL!UDSF
PUSHJ P,MAKLL
MOVEI N,(PN)
MOVSI NA,DEFFL!UDSF
POPJ P,
;THIS IS A LOW PRIORITY ITEM FOR TENEXIZING -- SO IT ISN'T
^%FNM1: ;.FNAM1
ITS,< MOVE N,SRCSTS+1 > ;ITS - GET FULL WORD FILE NAME
NOTNX,<NOITS,< MOVE N,LNAM >>
TNX,< MOVE N,FILNM1 >
MOVEI NA,0 ;NO RELOCATION
TLO IFLG ;IDENTIFIER
POPJ P,
^%FNM2:
ITS,< MOVE N,SRCSTS+2 >
NOTNX,<NOITS,< HLLZ N,LNAM+1 >>
TNX,< MOVE N,FILNM2 >;TNX
MOVEI NA,0
TLO IFLG
POPJ P,
^%CPU: JFCL 17,.+1 ;.CPU. PSEUDO-MACRO. CLEAR FLAGS
MOVEI N,1 ;INITIAL ASSUMPTION (1=PDP6)
JRST .+1
JFCL 1,%166 ;166 PROCESSOR HAS PC CHANGE FLAG
MOVNI NA,1
AOBJN NA,.+1
JUMPN NA,%KA ;KA10 CARRIES ACROSS HALFWORDS
MOVEI NA,0
BLT NA,0
JUMPE NA,%KI ;KL10 ALWAYS UPDATES BLT POINTER
%KL: ADDI N,1 ;KL = 4
%KI: ADDI N,1 ;KI = 3
%KA: ADDI N,1 ;KA = 2
%166: MOVEI NA,0 ;166= 1. SET RELOCATION TO ZERO
TLO IFLG ;SET IDENTIFIER SEEN
POPJ P, ;RETURN VALUE.
^%OSFAI:MOVE N,[OSFAIL]
MOVEI NA,0
TLO IFLG ;IDENT SEEN.
POPJ P,
;COMPLEX ATOMS - EXPRESSIONS INSIDE BROKETS
^REFLAG:OPFLG!RELEF!MLFT!UNDF!ESPF!PAWF,,NOFXF!IOSW!ADFL!FLFXF
IRBO: PUSH P,[0] ;HERE TO DO COMPLEX ATOMS (BROKETED EXPRESSION)
PUSH P,[0]
DRIBL: TRO NOFXF ;NO FIXUPS
ACALL
TLNE AUNDF
ERROR [ASCIZ /UNDEFINED WORD IN <>/]
TRZN TRBF ;WAS EXPRESSION TERMINATED BY ] OR >?
JRST NIRBO ;NO. FLUSH UNTIL WE GET A BROKET
NEMP: TLON SFL ;HAVE WE SCANNED AHEAD?
PUSHJ P,SCAN ;NO, DO IT
MOVE T,-5(P) ;GET OLD FLAGS
TDZ 0,REFLAG
AND T,REFLAG ;RESTORE APPROPRIATE FLAGS
OR 0,T
TDZ 0,[SOPF!SCFL!PSOPF!IFLG,,TRBF]
TLO 0,NFLG
MOVE N,WRD
MOVE NA,WRD+1 ;RETURN VALUE
MOVSI L,-4(P)
ADDI L,1
BLT L,3 ;RESTORE AC'S
MOVSI L,-13(P)
HRRI L,PCNT
BLT L,PCNT+5 ;RESTORE PCNT ETC.
SUB P,[XWD 14,14]
POP P,EFSPNT
POPJ P,
NIRBO: MOVEI N,-1(P) ;SAVE VALUE WE SCANNED.
HRLI N,WRD ;...
BLT N,(P)
SLOP: TRO NOFXF ;NO FIXUPS
ACALL ;READ STUFF AND THROW IT AWAY
TRZN TRBF ;TERM BY ] OR >?
JRST SLOP ;NO. READ MORE AND THROW IT AWAY
MOVSI N,-1(P) ;PUT OLD VALUE...
HRRI N,WRD ;IN...
BLT N,WRD+1 ;WRD
JRST NEMP
BEGIN INP ;INP USED BY SCAN TO GET NEXT BUFFER
IFN STANSW,<
^^TVFILE:0
TVMSK: ASCII /________________00000______/
TVTXT: ASCII /COMMENT VALID 00000 PAGES/
LTVTXT__.-TVTXT
>;STANSW
^^INPOFS: 0 ;USED WHEN SWITCHING TO CALCULATE OFFSET.
INTEM: 0
0
RDDELF: 0
EOFPOP: MOVEM 17,TSV+17
MOVEI 17,TSV
BLT 17,TSV+16
TNX,< JSR CLSSRC>
MOVNI 7,FILSTL
ADDB 7,FILSTP ;POP STACK
SOS FILSTC ;DECREMENT FILE-STACK DEPTH
NOTNX,< MOVE 1,(7) ;DEVICE
MOVE 5,1(7) ;FILE
MOVE 3,2(7) ;EXT
MOVE 4,4(7) ;PPN
MOVEI 6,2 ;IO CHANNEL NUMBER
JSR INITIT ;LOOKUP THE FILE >;NOTNX
TNX,< MOVE 1,(7)
MOVEM 1,JFNTBL ;JFN >;TNX
MOVE 1,NOTNX,<7(7);> 4(7)
MOVEM 1,INPNTP ;POINTER TO FILE-INPNT (CURRENTLY THE BYTE-OFFSET)
MOVE 1,NOTNX,<3(7);> 1(7) ;GET OLD-INPNT
MOVEM 1,INPNT ;RESTORE OLD-INPNT (COULD BE THE BYTE-OFFSET THOUGH)
MOVE 1,@INPNTP ;GET THE REAL BYTE-OFFSET
MOVEM 1,BYPOFF# ;SAVE BYTE POINTER OFFSET
MOVE 1,NOTNX,<5(7);> 2(7) ;GET RECORD NUMBER
HLRZM 1,PGNM ;STORE FILE PAGE NUMBER
MOVE 2,NOTNX,<6(7);> 3(7)
HRRZM 2,INLINE
IFN STANSW,< HLREM 2,TVFILE ;RESTORE TVFILE >;STANSW
NOTNX,< USETI 2,(1) ;SET FOR CORRECT RECORD NUMBER
MOVEM 1,IRECN ;SET RECORD NUMBER (AVOID INCREMENT LATER) >;NOTNX
TNX,< HRRZM 1,IRECN
JSR XJFNS ;SEE INITIT
>;TNX
NOTNX,< MOVEI 1,IBUFR1 ;ADDRESS OF THE FIRST BUFFER
TLO 1,400000
MOVEM 1,IDB ;SET UP BUFFER >;NOTNX
MOVSI 17,TSV
BLT 17,17
JRST NXTFL1 ;PROCESS "NEXT FILE"
^NXTFL: SETZM BYPOFF ;BYTE POINTER OFFSET
SKIPE FILSTC ;ANYTHING ON THE FILE-STACK?
JRST EOFPOP ;YES. PROCESS IT.
JSR EOF ;GET NEXT FILE IF ANY
SETZM PGNM
AOS PGNM
SETZM INLINE
NXTFL1: SETZM SPGNM
SETZM TLBLK ;FLUSH SOS LINE #
SETZM SVLNUM ;"
TRNN LDEV
JRST .+4
MOVEI TAC,14
SKIPE XPNDSW
IDPB TAC,LSTPNT
PUSHJ P,LSTFRC
SKIPE RDDELF
IBP LSTPNT ;NEED THIS BECAUSE NEXT CHR GETS STOWED WITH DPB
SETZM RDDELF
SKIPE BYPOFF ;ANY BYTE-POINTER OFFSET?
JRST INPX0 ;YES. LET'S SKIP THIS.
^^TVSKIP: ;ROUTINE TO IDENTIFY TVEDIT FILES
SETZM RDDELF
SETZM BYPOFF
NOTNX,< IN 2, ;READ FIRST REC
AOSA IRECN ;COUNT A RECORD READ
JRST INP0 ;LOSE >;NOTNX
TNX,< SETZM IRECN
JSR TNXIN >;TNX
IFN STANSW,< ;AT STANFORD, IDENTIFY TV FORMAT FILES
SETZM TVFILE ;FIRST ASSUME NON-TV
MOVSI B,-LTVTXT
MOVSI TAC,B
ADD TAC,INPNT
IBP TAC
TVSKP1: MOVE C,@TAC ;SEE IF THIS IS A DIRECTORY
XOR C,TVTXT(B)
TDNN C,TVMSK(B)
AOBJN B,TVSKP1
JUMPL B,INP0A
SETOM TVFILE ;REMEMBER THIS FOR EDITOR CALL >;STANSW
JRST INP0A
^^INP: TDZA B,B ;FLAG THAT THIS IS NOT A CALL VIA DELTAB
^INPDT: MOVEI B,1
MOVEM B,RDDELF ;SAVE FLAG
AOS IRECN ;INCREMENT RECORD NUMBER.
SETZM BYPOFF ;NO BYTE-POINTER OFFSET
INPX0:
NOTNX,< INPUT 2, >;NOTNX - GET NEXT BUFFERFUL
TNX,< JSR TNXIN >;TNX
NOTNX,<
INP0: STATZ 2,740000
FATAL [ASCIZ \FATAL I/O ERROR ON INPUT\]
STATZ 2,20000
JRST NXTFL >;NOTNX
INP0A: MOVE B,INPNT ;INPNT IS IDB+1
IBP B
HRRZM B,INPOFS ;STORE FIRST ADDRESS
MOVE B,IDB+2 ;CHARATER COUNT
MOVEM B+1,INTEM ;B+1 IS ABOUT TO BE CLOBBERED
ADDI B,4 ;ROUND UP TO MAKE A WORD COUNT
IDIVI B,5 ;B_NUMBER OF WORDS IN BUFFER
ADD B,INPOFS ;ADDRESS OF END OF BUFFER
MOVE B+1,[BYTE(7)177,0]
MOVEM B+1,(B) ;STUFF 177 0 INTO END OF BUFFER.
IFE STANSW,<NOTNX,<NOITS,<
SKIPN INTTYF ;IS INPUT DEVICE A TTY?
JRST INP0A9 ;NO. FORGET THIS
MOVE B,IDB+1 ;GET THE BYTE POINTER
INP0A0: ILDB B+1,B ;GET A BYTE
CAIE B+1,"Z"-100
JRST INP0A1
MOVEI B+1,0 ;LOOK THRU BUFFER FLUSHING ^Z.
DPB B+1,B
INP0A1: CAIE B+1,177 ;177 MARKS END OF BUFFER
JRST INP0A0 ;LOOP.
>;NOITS>;NOTNX >;IFE STANSW
INP0A9: MOVE B+1,INTEM ;RESTORE B+1
SKIPN B,BYPOFF ;ANY BYTE-OFFSET?
POPJ P,
ADD B,INPOFS ;ADD FIRST ADDRESS TO THE OFFSET.
PUSH P,B ;B NOW CONTAINS THE FILE-INPNT
MOVE B,FILSTP ;GET FILE-STACK POINTER
MOVE B,NOTNX,<3(B);> 1(B) ;GET OLD-INPNT
MOVEM B,INPNT ;SAVE IT (IN CASE WE'RE IN A MACRO)
POP P,@INPNTP ;STORE NEW FILE-INPNT
SETZM BYPOFF ;DEPARTMENT OF REDUNDANCY DEPARTMENT
POPJ P,
TNX,<
;READ NEXT BUFFER FULL (GENERALLY A PMAP, WE HOPE)
TNXIN: 0
TSVAC <1,2,3>
SKIPL 1,JFNTBL
JRST TNXIN2 ;IF NOT A PMAPPABLE FILE
HRRZS 1,1
MOVE 2,[XWD 2,11] ;TWO WDS, FDBBYV,FDBSIZ
MOVEI 3,2 ;TO AC 2
GTFDB
LSH 2,-30 ;JUSTIFY BYTE SIZE
ANDI 2,77 ;AND MASK OFF
CAIE 2,7 ;IS IT 7 BIT ASCII?
IMULI 3,5 ;MUST BE FULL WORDS...
MOVE 2,IRECN
IMULI 2,1000*5 ;TOT BYTES NOT INCL THIS PAGE
CAML 2,3
JRST NXTFL ;EOF
ADDI 2,1000*5
SUB 3,2 ;SIZE-TOT BYTES TO END OF THIS PAGE
SKIPL 3
SETZ 3, ;EOF NOT ON THIS PAGE
ADDI 3,1000*5
MOVEM 3,INPNT+1 ;CORRECT NUMBER OF BYTES (I HOPE)
HRLS 1,1
HRR 1,IRECN ;JFN,,PAGE
MOVE 2,[XWD 400000,SRCBFP] ;THIS FORK, SOURCE BUFFER PAGE
HRLZI 3,100400 ;READ/CPY WRITE
PMAP
TNXIN1: MOVE 1,[POINT 7,SRCBF]
MOVEM 1,INPNT ;SET POINTER
TRSTAC <1,2,3>
JRST @TNXIN
TNXIN2: TLNE 1,200000 ;TERMINAL BIT
JRST TNXIN3 ;IS A TTY...SPEC EOF CONVENTION
HRRZS 1,1 ;CLEAR FLAGS
MOVE 2,[POINT 36,SRCBF]
MOVNI 3,1000
SIN
ADDI 3,1000 ;FORM COUNT OF BYTES READ
IMULI 3,5 ;CONV TO 7 BIT BYTES
JUMPE 3,NXTFL ;LOSE
MOVEM 3,INPNT+1 ;SET COUNTER
SETZ 3,
REPEAT 5,< IDPB 3,2 ;SO THE BUFEND DETECTION WONT FUCK UP >
JRST TNXIN1
TNXIN3: TLNE 1,100000 ;OUR OWN EOF BIT
JRST NXTFL ;YEP....
HRROI 1,SRCBF
MOVEI 2,1000*5-1 ;LV ROOM FOR LF
TNXI3A: SETZ 3,
NOT20,<
PSTIN ;HAD BETTER BE CONTROLLING TTY
>;NOT20
T20,< HRLI 2,(1B0!1B3) ;BREAK ON CRLF, ESC, OR ^Z.
RDTTY
ERJMP .+1
HRRZ 2,2 ;leave count only
>;T20
LDB 3,1 ;GET TERMINATOR
CAIN 3,32 ;CTRLZ FOR EOF?
JRST TNXI3B ;IF EOF...
T20,< CAIN 3,12 ;BREAK ON LF TOO
JRST TNXI3D ;SPECIAL PLACE FOR LF >;T20
CAIN 3,15 ;IS IT CR?
JRST TNXI3C ;YES, CR
JUMPG 2,TNXI3A ;ARB TERMINATOR, ROOM REMAINS
MOVEI 3,1000*5-1
MOVEM 3,INPNT+1 ;UNLIKELY BUT BUFFER IS FULL
JRST TNXIN1
TNXI3B: MOVEI 3,15 ;CR
DPB 3,1 ;STORE OVER CTRLZ
MOVE 3,JFNTBL
TLO 3,100000 ;EOF BIT
MOVEM 3,JFNTBL
TNXI3C: MOVEI 3,12 ;LF
IDPB 3,1 ;STORE IT
SOJ 2, ;AND ACCOUNT FOR IT
TNXI3D: SUBI 2,1000*5-1
MOVNS 2,2 ;NUMBER OF BYTES READ
MOVEM 2,INPNT+1
SETZ 3,
REPEAT 5,< IDPB 3,1 ;SO BUF TERM TEST WONT FUCKUP >
JRST TNXIN1
>;TNX
BEND INP
BEND SCAN
SUBTTL REVAL -- EVALUATES EXPRESION INTO LIST-POLISH
BEGIN REVAL
^REVAL: MOVE O,FS ;INITIALIZE
TLNE SCFL ;SPC CHR?
JRST SPC1 ;YES
REVAL1: PUSH FS,N ;PUT NUM...
PUSH FS,NA ;INTO STRG
TLNN B,ARFL ;ARITH OP COMING UP?
JRST NOA1 ;NO
TLZE B,UNOF
CAIN C,"-"
JRST .+2
PUSHJ P,UOPERR
REVALU: MOVE T,B
TLO T,SNB ;MARK AS OPERATOR
PUSH FS,FS ;STORE POINTER TO NUM...
PUSH FS,T ;WITH OPERATOR
HRRZ O,FS ;SET "OLD OP" POINTER
LOOP2: PUSHJ P,SCANS ;GET A PREVIEW
LOOP4: TLNN B,ENMF ;NOT A NUM COMING?
JRST SPC2 ;NOT A NUM COMING
PUSHJ P,SCANS ;GET NEXT NUM
LOOP4A: HRRZ T,B ;ENTER HERE FROM SPC2B
TLNN B,ARFL ;ARITH OP COMING?
MOVEI T,16 ;NO,SET LEVEL=16
LOOP3: CAIGE T,@(O) ;COMPARE NEW OP LEVEL WITH OLD
JRST NLOW ;NEW ONE LOWER
PUSH FS,N ;PUT NUM...
PUSH FS,NA ;IN STRG
HRLM FS,-1(O) ;AND POINT OLD OP AT IT
LOOP1: CAML T,-1(P) ;COMPARE NEW OP WITH LIMIT
JRST NGL ;NEW GREATER OR EQUAL LIMIT
MOVE T,B ;MARK NEW OP ...
TLO T,SNB ;AS OPERATOR
TLZE T,UNOF
CAIN C,"-"
JRST .+2
PUSHJ P,UOPERR
PUSH FS,O ;POINT TO OLD OP
PUSH FS,T ;WITH NEW
HRRZ O,FS ;SET "OLD OP"
JRST LOOP2
NGL: MOVEM O,-1(P) ;RETURN "OLD OP"
POPJ P,
NLOW: PUSH P,O ;SAVE "OLD OP"
MOVEI O,@(O) ;GET LEVEL OF OLD OP
PUSH P,O ;USE AS LIMIT
PUSHJ P,REVAL ;CALL REVAL
MOVE O,-1(P) ;GET OD OP POINTER
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;POINT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1] ;POP
JRST LOOP1
UOPERR: ERROR [ASCIZ/UNARY OPERATOR ILLEGAL AFTER AN EXPRESSION/]
TRO POLERF
MOVEI C,"+" ;CHANGE TO A BINARY OPERATOR
MOVE B,[SNB!SPCLF!ARFL,,12]
MOVE T,B
POPJ P,
SPC2: TLNE B,UNOF ;UNARY OPERATOR?
JRST UNAR ;YES
TRNE B,LFPF ;(?
JRST LFTP
TRNE B,UDARF ;POSSIBLE UPARROW?
TRNN B,TP2F ;DEFINITE UPARROW?
JRST SPC2A ;NOT UPARROW
TLZ SFL ;SKIP THE ^
PUSHJ P,DSCANS ;TRY TO READ DECIMAL (OR WHATEVER) NUMBER
TLNE NFLG ;GOT A NUMBER?
JRST LOOP4A ;YES. USE IT.
SPC2A: TRO POLERF ;SET ERROR FLAG
ERROR [ASCIZ/ILLEGAL CHR AFTER OPERATOR/]
JRST NGL ;RETURN
UNAR: HRRI B,2 ;MARK AS UNARY
PUSH P,O ;SAVE OLD OP PNT
MOVEI O,@(O) ;GET LEVEL OF OLD OP
PUSH P,O ;USE AS LIMIT IN CALL
PUSHJ P,REVALU ;CALL REVAL(OTHER ENTRANCE)
OLF: MOVE O,-1(P) ;GET OLD OP
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;PNT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1];POP
JRST LOOP1
LFTP: TLZ SFL ;IGNORE PAREN
PUSHJ P,SCANS ;GET NEXT
PUSH P,O ;SAVE O
PUSH P,[16] ;SET LIMIT =16
PUSHJ P,REVAL ;CALL REVAL
MOVE O,-1(P) ;GET OLD OP
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;PNT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1]
TRNN B,RTPF ;RIGHT PAREN LAST THING?
JRST NRP ;NO
PUSHJ P,SCANS ;GET THE RIGHT PAREN FF.
TLNN B,ARFL ;ARITH OP NEXT?
JRST NGL ;NO
HRRZ T,B ;YES, SET T ...
CAIL T,@(O) ;COMPARE LEVEL
JRST LOOP1 ;AND PROCEED
MOVE T,B
TLO T,SNB
TLZE T,UNOF
CAIN C,"-"
JRST .+2
PUSHJ P,UOPERR
PUSH P,O ;SAVE OLD OP
HLRZ O,-1(O) ;GET RETURNED VALUE BACK
PUSH FS,O ;POINT NEW OP AT IT
PUSH FS,T ;PUSH OP
HRRZ O,FS ;SET OLD OP
HRRZ T,@(P) ;GET LEVEL
PUSH P,T
PUSHJ P,LOOP2
JRST OLF
NRP: TLON REUNBF ;SET UNBAL FLAG
ERROR [ASCIZ/UNBAL PARENS/]
TRO POLERF ;SET ERROR FLAG
JRST NGL ;RETURN
SPC1: TLNE N,UNOF ;UNARY OPERATOR?
JRST UNAR1 ;YES
TRNE N,LFPF ;(?
JRST LFTP1 ;YES
TRNE N,UDARF ;POSSIBLE UPARROW?
TRNN N,TP2F ;YES. IS IT REALLY UPARROW?
JRST SPC1A ;NOT UPARROW
PUSHJ P,DSCANS ;TRY TO FIND A NUMBER
TLNE NFLG ;GOT A NUMBER?
JRST REVAL1 ;YES!
SPC1A: ERROR[ASCIZ/ILLEGAL CHR STARTS EXPRESSION/]
TRO POLERF ;SET ERROR FLAG
MOVEI T,16
JRST NGL
UNAR1: PUSH FS,FS ;PUSH ANY OLD THING
HLLZ T,N
OR T,[XWD SNB,2];MARK AS UNARY OP
PUSH FS,T
HRRZ O,FS
JRST LOOP4
LFTP1: PUSHJ P,SCANS ;GET
^LFTP2: PUSH P,[16] ;SET LIMIT=16
PUSHJ P,REVAL ;GET VALUE
POP P,O ;GET VALUE
TRNN B,RTPF ;)?
JRST NRP ;NO
PUSHJ P,SCANS ;GET PAST THE )
TLNE B,ARFL ;ARITH OP NEXT?
JRST PARAR ;YES
TLO O,SNB ;MARK VALUE AS "PARENS AROUND WHOLE"
MOVEM O,-1(P) ;RETURN
POPJ P,
^PARAR: PUSH FS,O ;POINT TO VALUE...
MOVE T,B ;...
TLO T,SNB ;...
TLZE T,UNOF
CAIN C,"-"
JRST .+2
PUSHJ P,UOPERR
PUSH FS,T ;FROM CURRENT OP
HRRZ O,FS ;SET OLD OP
JRST LOOP2
NOA1: HRRZM FS,-1(P) ;RETURN OPERAND
MOVEI T,16 ;SET LEVEL=16
POPJ P, ;RETURN
BEND
SUBTTL REDUC -- REDUCES THE LIST STRUCTURE POLISH POINTED TO BY FS
BEGIN REDUC
^REDUC: SKIPL (FS) ;SINGLE OPERAND?
POPJ P, ;YES
PUSH P,FS ;SAVE POINTER
MOVE O,(FS) ;GET BITS
TLNE O,UNOF ;UNARY OP?
JRST PT1 ;YES
MOVE FS,-1(FS) ;GET POINTER TO FIRST OPERAND
SKIPGE (FS) ;OPERATOR OR OPERAND?
PUSHJ P,REDUC ;OPERATOR, REDUCE
PT1: MOVE FS,(P) ;GET POINTER
MOVS FS,-1(FS) ;GET POINTER TO SECOND OPERAND
SKIPGE (FS) ;OPERATOR?
PUSHJ P,REDUC ;YES, REDUCE
MOVE FS,(P) ;GET POINTER
MOVE O,(FS) ;GET BITS
TLNE O,UNOF ;UNARY OP?
JRST PT2 ;YES
MOVE O,-1(FS) ;GET PNTR TO FIRST OP
SKIPGE FS,(O) ;OPERAND?
JRST CPOP ;NO, CAN'T REDUCE
TLNE FS,DEFFL ;DEFINED?
JRST CPOP ;NO, CAN'T REDUCE
PT2: MOVE FS,(P) ;GET PNTR.
MOVS FS,-1(FS) ;GET PNTR TO SECOND OP
SKIPGE T,(FS) ;OPERAND?
JRST CPOP ;NO, CAN'T REDUCE
TLNE T,DEFFL ;DEFINED?
JRST CPOP ;NO, CAN'T REDUCE
MOVE T,(P) ;GET POINTER
MOVE T,(T) ;GET OPERATION
DPB T,[POINT 5,T,4] ;TACK ARMD & ARMD1 ...
LDB T,[POINT 7,T,6] ;ONTO LEVEL
HRRZ T,OPTB1-10(T) ;GET DISPATCH ADDRESS
JUMPN T,(T) ;DO IT.
ERROR [ASCIZ/UNKNOWN ILLEGAL OPERATOR IN POLISH REDUCTION/]
SETZB O,T ;SET VALUES TO ZERO AND FALL INTO RRETT
RRETT: POP P,FS ;GET POINTER
MOVEM T,-1(FS) ;DEPOSIT VALUE
MOVEM O,(FS) ;DEPOSIT BITS
POPJ P, ;RETURN
CPOP: POP P,O
POPJ P,
DEFINE AROP(BOP,SPC1,SPC2,BTOP,MGNM,Q)
< MOVE T,-1(O) ;GET SECOND OP
SPC1
BOP T,-1(FS) ;BOP FIRST OP
SPC2
MOVE O,(O) ;GET BITS FOR SECOND OP
BTOP O,(FS) ;BTOP BITS FOR FIRST
TRNE O,MGNM ;LEGAL RELOC?
JRST CPOP ;NO
Q DPB O,[POINT 4,(FS),35]
Q MOVE O,(FS) ;GET NEW BITS
JRST RRETT
>
;HERE ARE THE ROUTINES FOR THE REDUCTION OF POLISH EXPRESSIONS BY THE ASSEMBLER
TM: 0 ;TEMP CELL FOR ROUTINES BELOW
ADOP: AROP(ADD,,,ADD,12)
SBOP: AROP(SUB,,,SUB,12)
MULOP: AROP(IMUL,,,OR,17,<;>)
DIVOP: AROP(IDIV,<MOVEM FS,TM>,<MOVE FS,TM>,OR,17,<;>)
ANOP: AROP(AND,,,OR,17,<;>)
OROP: AROP(OR,,,OR,17,<;>)
XROP: AROP(XOR,,,OR,17,<;>)
LSHF: AROP(LSH @ ,<HRRZS -1(FS)>,,OR,17,<;>)
REMOP: MOVE T,-1(O) ;GET SECOND OP
MOVEM FS,TM
IDIV T,-1(FS) ;DIVIDE BY FIRST OP
MOVE T,FS ;GET RESULT INTO T
MOVE FS,TM ;RESTORE FS
MOVE O,(O) ;GET BITS FOR SECOND OP
OR O,(FS) ;OR BITS FOR FIRST
JRST UNMIN2 ;CHECK FOR LEGAL RELOC
UNMIN: MOVN T,-1(FS) ;NEGATE NUM
UNMIN1: MOVE O,(FS) ;GET BITS
UNMIN2: TRNE O,17 ;RELOC LEGAL?
JRST CPOP ;NO
JRST RRETT
UNABS: MOVM T,-1(FS) ;ABSOLUTE VALUE
JRST UNMIN1
UNNOT: SETCM T,-1(FS) ;INVERT NUM
JRST UNMIN1 ;CHECK FOR LEGAL RELOC
JFFOOP: MOVE T,-1(FS) ;GET OPERAND
MOVEM FS,TM ;SAVE T+1
JFFO T,.+2 ;SET FS AND JUMP
MOVEI FS,44 ;T WAS ZERO. DESIRED RESULT IS 44
MOVE T,FS ;RESULT IN T
MOVE FS,TM ;RESTORE FS
JRST UNMIN1 ;MAKE SURE WE HAVE NO RELOC PROBLEMS
;DISPATCH TABLE FOR POLISH OPERATORS.
;RH IS ADDRESS FOR REDUCTION.
;LH IS CORRESPONDING OPERATOR FOR THE LOADER (SHIFTED BY 6) USED BY LABINS&POLOUT
^^OPTB1:1300,,UNNOT ;10 NOT (^E)
1500,,JFFOOP ;11
1400,,UNMIN ;12 UNARY -
1700,,UNABS ;13 ABSOLUTE VALUE
0
0
0
0
1100,,LSHF ;20
0
0
0
0
0
0
0
1000,,OROP ;30
1200,,XROP ;31 XOR
700,,ANOP ;32
0
0
0
0
0
500,,MULOP ;40 *
0
600,,DIVOP ;42 /
1600,,REMOP ;43
0
0
0
0
300,,ADOP ;50 +
0
400,,SBOP ;52 BINARY -
BEND
SUBTTL MEVAL -- MAIN EVALUATER -------
;MEVAL -- EVALUATES AN ADDRESS FIELD EXPRESSION & GENERATES
;FIXUPS. RETURNS OPCODES UNTOUCHED.
;IF MLFT IS ON, GENERATES LEFT HALF FIXUPS INSTEAD OF RIGHT.
BEGIN MEVAL
^MEVAL: TLZ SOPF!PSOPF!PAWF!ESPF!UNDF
MOVE FS,EFSPNT
PUSHJ P,SCANS ;GET THING
TLNE SCFL ;SPEC. CHR?
JRST MSPEC ;YES
TLNE NFLG ;NUM?
JRST MNUM ;YES
TRNE B,LACF ;TERM BY _ OR :?
JRST DEFN ;YES
TLNE SOPF ;OPCODE?
TLOA OPFLG
MNUM: TLOA OPFLG ;STOP OPCODE LOOKUP
POPJ P,
TLNE B,ARFL ;ARITH OP NEXT?
JRST NONSIM ;YES
TLNN NA,DEFFL ;DEFINED?
POPJ P, ;YES
TLO UNDF ;NO, SET BIT
TRNE NOFXF ;GENERATE FIXUPS?
POPJ P, ;NO
MOVE T,OPCNT+1 ;GET CURRENT OUTPUT LOC. COUNTER BITS
TLNE T,INCF ;IN CORE?
JRST NOTHER ;YES
SKIPN O,3(PN) ;GET FIXUP POINTER
JRST NOTHER ;NONE
LOOP1: SKIPN (O) ;ZERO DEVIATION?
JRST FND1 ;YES, FOUND
LOOP2: SKIPE O,1(O) ;END OF CHAIN?
JRST LOOP1 ;NO
NOTHER: GFST O,FSTPNT ;GET SOME FREE STRG
SETZM (O) ;ZERO DEVIATION
LOOP4: MOVEM T,4(O) ;DEPOSIT CURRENT LOCAT. CNT.FLAGS
MOVE TAC,OPCNT ;GET CURRENT LOC. CNT.
MOVEM TAC,3(O) ;DEPOSIT
SETZM 2(O) ;MAKE FLAGS
TLNE MLFT ;LEFT HALF?
JRST [AOS 2(O) ;YES SET BIT
TLNE T,INCF ;IN CORE?
MOVEM O,2(TAC) ;YES
JRST SARND]
TLNE T,INCF ;IN CORE?
MOVEM O,(TAC) ;YES, SET REVERSE FIXUP PNTR.
MOVEI T,2
TRNE FLFXF ;FULL WORD FIXUPS?
ORM T,2(O) ;YES, MARK
SARND: MOVE T,3(PN) ;FIXUP PNTR.
EXCH T,1(O) ;PUT NEW THINGS...
MOVEM O,3(PN) ;INTO CHAIN
MOVEM T,FSTPNT ;ADVANCE FREE STRG PNTR.
SETZB N,NA ;VALUE IS 0
HRRZS O
POPJ P,
FND1: MOVE TAC,4(O) ;GET NUM FLAGS
TLNE TAC,INCF ;IN CORE?
JRST LOOP2 ;YES
MOVE TAC,2(O) ;GET FLAGS
TLNN MLFT ;LEFT HALF NOW?
TRCN TAC,1 ;IS THIS LEFT HALF?
TRNN TAC,1 ;OR THIS?
JRST LOOP2 ;NO MATCH
TRNN FLFXF ;FULL WORD NOW?
TRCN TAC,2 ;IS THIS FULL WORD?
TRNN TAC,2 ;OR THIS?
JRST LOOP2 ;NO MATCH
FND1A: MOVE N,OPCNT ;GET NEW VALUE AND SWITCH WITH OLD.
MOVE NA,OPCNT+1 ;FOR SIMPLE FIXUP, VALUE RETURNED IS LOCATION OF
EXCH N,3(O) ;THE PREVIOUS REFERENCE.
EXCH NA,4(O) ;NEW VALUE IS LOC. CNTR.
HRRZS O
POPJ P,
NONSIM: TLZ RELEF!REUNBF ;CLEAR FLAGS
TLO OPFLG ;INHIBIT OPCODE LOOKUP
MOVE FS,EFSPNT
NONSM2_.+2 ;RET FROM REVAL
RVALUA
PUSHJ P,REDUC ;REDUCE TO VALUE IF POS.
TLNE RELEF ;RELOC ERROR?
ERROR [ASCIZ/RELOCATION ERROR/]
POP P,FS ;GET POINTER TO POLISH
SKIPGE FS ;PARENS AROUND WHOLE?
TLO PAWF ;YES
SKIPGE O,(FS) ;DEFINED?
JRST NOTDF ;NO
MOVE N,-1(FS) ;GET VALUE...
MOVE NA,O ;AND VALUE FLAGS
TLNE NA,DEFFL ;MAKE SURE UNDEF HAS BEEN SET RIGHT
TLO UNDF
POPJ P,
NOTDF: TLO UNDF ;UNDEF.
TRNE NOFXF ;GENERATE NO FIXUPS?
POPJ P, ;NO
HRRZ T,O ;GET LEVEL
CAIE T,12 ;+ OR -?
JRST POLFIX ;NO
MOVE PN,-1(FS) ;GET POINTER TO RIGHT ARG.
MOVS T,PN ;GET POINTER TO LEFT ARG.
SKIPGE N,(PN) ;GET RIGHT ARG -- OPERAND?
JRST POLFIX ;NO
SKIPGE NA,(T) ;GET LEFT ARG. -- OPERAND?
JRST POLFIX ;NO
TLNN NA,DEFFL ;LEFT ARG DEFINED?
JRST OK1 ;YES
TLNE N,DEFFL ;RIGHT ARG DEFINED?
JRST POLFIX ;NO
TLNE O,ARMD ;+ OR -?
JRST POLFIX ;-
EXCH PN,T
EXCH NA,N ;SWITCH ARGS
OK1: TRNE NA,17 ;ANY RELOC ON LEFT ARG?
JRST POLFIX ;YES
TLNN O,ARMD ;-?
SKIPA NA,-1(T) ;NO, GET VALUE
MOVN NA,-1(T) ;YES, GET NEGATIVE VALUE
MOVE PN,-1(PN) ;GET SYMBOL TABLE POINTER
^CCFIX: MOVE T,OPCNT+1 ;GET FLAGS
TLNE T,INCF ;IN CORE?
JRST NOF ;YES
SKIPN O,3(PN) ;GET FIXUP CHAIN
JRST NOF ;NONE
SRC: SRC1(NA,O,FND2,JRST NOF)
^DBLUP: 0
FND2: MOVE TAC,4(O) ;GET NUM FLAGS
TLNE TAC,INCF ;IN CORE?
JRST SRC+2 ;YES
MOVE TAC,2(O) ;GET FLAGS
TLNN MLFT ;LEFT HALF NOW?
TRCN TAC,1 ;IS THIS LEFT HALF?
TRNN TAC,1 ;OR THIS?
JRST SRC+2 ;NO MATCH, CONTINUE SEARCH
TRNN FLFXF ;FULL WORD NOW?
TRCN TAC,2 ;IS THIS FULL WORD?
TRNN TAC,2 ;OR THIS?
JRST SRC+2 ;NO MATCH
JRST FND1A
NOF: GFST O,FSTPNT ;GET SOME FREE STRG.
MOVEM NA,(O) ;STORE DEVIATION
JRST LOOP4
MSPEC: TDNN N,[XWD UNOF,LFPF!UDARF] ;( OR UP/DOWN arrow OR UNARY OP?
JRST [TLO OPFLG!ESPF
POPJ P,]
TRNE N,LFPF
JRST IXTST ;( SEE IF INDEX
TLNE N,UNOF
JRST NONSIM ;UNARY OP
SETZM DBLUP ;NO DOUBLE UP ARROW YET.
PUSH P, ;SAVE FLAGS
PUSH P,N ;SAVE UP/DOWN
TLO OPFLG ;INHIBIT OPCODE SEARCH
TRNN N,TP1F ;UP OR DOWN?
JRST MSPE2 ;UP ARROW SEEN
MSPE1: PUSHJ P,SCANS ;GET IDENTIFIER
TLNE IFLG ;IDENT SEEN?
TRNN B,LACF ;YES. WAS : or = SEEN NEXT?
JRST ERR1 ;NO IDENT OR IMPROPER TERMINATION
MOVEM L,LSTLAB+2 ;SAVE SIXBIT OF LAST NAME DEFINED
POP P,L ;GET UP/DOWN FLAG
ANDI L,TP1F!TP2F ;SET UP/DOWN ONLY
TRNE B,TP1F ;= OR : NEXT?
JRST LADF ;= NEXT
JRST PTQ1 ;: NEXT
MSPE2: PUSHJ P,DSCANS ;GET IDENT - POSSIBLE NUMBER HERE (^D69)
TLNN IFLG ;IDENT?
JRST [TLNE NFLG ;POSSIBLE NUMBER?
JRST [SUB P,[2,,2]
JRST MNUM] ;TREAT AS NUMBER
TRNN N,TP2F ;ANOTHER ^
JRST ERR1 ;NO -- LOSE
SETOM DBLUP ;SET ^^FLAG
JRST MSPE1] ;GOBBLE ORDINARY IDENT NEXT
TRNN B,LACF ;: OR _ NEXT?
JRST ERR1 ;NO - ERROR
MOVEM L,LSTLAB+2 ;SAVE SIXBIT
POP P,L
MOVEI L,TP2F ;SET UPARROW
TRNE B,TP1F ;_ OR :?
JRST LADF ;_
PTQ1: MOVE NA,PCNT+1 ;GET LOCATION FLAGS
TLNE NA,INCF ;IN CORE?
JRST PTQ2 ;AVOID CONFUSION CAUSED BY LABELS IN LITERALS
MOVE N,LSTLAB+2 ;SET UP LABEL NAME
MOVEM N,LSTLAB
MOVE N,LSTLAB+3 ;AND BLOCK NAME
MOVEM N,LSTLAB+1 ;FOR ERROR MESSAGE PRINTER
MOVE N,PCNT ;GET CURRENT LOC...
MOVEM N,LSTLAB+4 ;DEPOSIT FOR ERROR PRINT
PTQ2: MOVE N,PCNT ;(NECESSARY IF WE TAKE THE SHORT CUT)
EXCH L,(P) ;GET OLD FLAGS, SAVE LABINS FLAGS
ANDCA L,[XWD OPFLG,0] ;CLEAR ALL BUT OPFLG
ANDCM L ;TURN OFF OPFLG IF IT WAS OFF
PUSHJ P,SCAN1A ;LOOK FOR ANOTHER :
POP P,L ;GET BACK FLAGS FOR LABINS
TLO L,COLONF ;MARK : TYPE
TRNN B,LACF ;ANOTHER :?
JRST .+3 ;NO
TLZ SFL ;SKIP SECOND :
TLO L,DBLF ;MARK __ TYPE (::)
PUSHJ P,LABINS ;INSERT (DEFINE) LABEL
SETZM DBLUP ;FLUSH ARROWS THAT ARE LURKING
SKIPE XCRFSW ;CREF?
SKIPN LISTSW ;YES. AND LISTING?
JRST MEVAL ;NO.
MOVEI N,2 ;YES
IDPB N,CREFPT
JRST MEVAL
ERR1: SUB P,[1,,1]
ERROR [ASCIZ/NO IDENT OR NO : OR _ AFTER UP-ARROW OR DOWN-ARROW/]
POP P,N
ANDCA N,[XWD OPFLG,0] ;GETSTORE ...
ANDCM N ;OLD OPFLG
JRST MEVAL
;HERE WHEN = OR : SEEN FOLLOWING A SYMBOL NAME
DEFN: PUSH P, ;SAVE OLD FLAGS
TLO OPFLG ;INHIBIT OPCODE LOOKUP
TLNE SOPF ;FOUND AS OPCODE?
PUSHJ P,RESCN ;YES , FIND AS LABEL
MOVEM L,LSTLAB+2 ;SAVE SIXBIT
MOVEI L, ;NO FLAGS (NO ^ OR DOWN-ARROW)
TRNN B,TP1F ;_ OR :?
JRST PTQ1 ;:
LADF: MOVEI O,0 ;INITIALIZE COUNT
LLOP: SKIPE XCRFSW ;CREF IN PROGRESS NOW?
JRST [MOVEI TAC,7 ;YES DELETE PREVIOUS SYMBOL OUTPUT
SKIPE LISTSW ;LISTING IN PROGRESS NOW?
IDPB TAC,CREFPT ;YES.
JRST .+1]
SKIPE DBLUP ;^^ SEEN?
TLO L,DBLUPF ;YES. MARK IT
SETZM DBLUP ;CLEAR CORE FLAG
PUSH P,PN ;SAVE POINTER INTO SYMTAB
PUSH P,L ;SAVE FLAGS
ADDI O,1 ;COUNT
TLZ SFL ;SKIP THE _
CAIN C,"=" ;WAS CHAR REALLY =?
JRST EQLDEF ; = SEEN. CHECK FOR ==
LLOP1: PUSHJ P,SCANS ;GET NEXT
TLNE SCFL ;SPC CHR?
JRST SCHAN ;YES
TLNN IFLG ;IDENT?
JRST LNMM ;NO, MUST BE A NUM.
TRNN B,LACF ;_ OR : NEXT?
JRST LNMM ;NO. MUST BE THE VALUE TO ASSIGN
MOVEI L,0 ;YES
JRST LLOP
SCHAN: TRNN N,LACF ;_ OR : NEXT?
JRST SCNT ;NO
TRNN N,TP1F ;SKIP IF _ NEXT
SKIPA N,[INTF,,0] ;WAS : MUST BE =: OR ==:
SCHLA: MOVSI N,DBLF ;SET __
ORM N,(P) ;SET FLAG (EITHER DBLF OR INTF)
JRST LLOP1
SCNT: TRNN N,UDARF ;^ OR DOWN-ARROW?
JRST LNMM ;NO
PUSH P,N ;SAVE CHR.
TRNN N,TP1F ;UP OR DOWN?
JRST SCNT2 ;UPARROW
SCNT1: PUSHJ P,SCANS ;GET IDENTIFIER
TLNE IFLG ;IDENT SEEN?
TRNN B,LACF ;YES, AND : OR = NEXT?
JRST ERR2 ;NO TO ONE OF ABOVE
POP P,L
ANDI L,TP1F!TP2F ;MASK OUT IRRELEVANCIES
JRST LLOP ;DO REST
SCNT2: PUSHJ P,DSCANS ;GET IDENT (POSSIBLE NUMBER: ^D69)
TLNE NFLG ;POSSIBLE NUMBER.
JRST [SUB P,[1,,1]
JRST LNMM] ;HANDLE AS A NUMBER
TLNN IFLG ;IDENT SEEN NEXT?
JRST [TRNN N,TP2F ;ANOTHER ^ NEXT?
JRST ERR2 ;NO. AN ERROR.
SETOM DBLUP ;MARK CORE FLAG FOR ^^
JRST SCNT1] ;FIND IDENT
TRNN B,LACF ;: OR _ NEXT?
JRST ERR2 ;NOPE, LOSE
POP P,L ;GET CHARACTER BACK
ANDI L,TP1F!TP2F ;CLEAR REST
JRST LLOP
ERR2: SUB P,[1,,1]
ERROR [ASCIZ/NO IDENT OR NO _ AFTER UP-ARROW OR DOWN-ARROW/]
TLNN B,CRFG ;CR NEXT?
JRST LLOP1 ;NO. TRY AGAIN
TLO SFL ;SET SCAN AHEAD (AVOID ERRORS ABOUT COMMENTS
SETZB N,NA
JRST LLOP2 ;"DEFINE" THE SYMBOLS WE'VE SEEN.
EQLDEF: PUSHJ P,SCAN1 ;KLUDGE TO MAKE == WORK
CAIN C,"="
JRST SCHLA ;IF VERY NEXT CHAR IS =, TREAT IT AS _
TLO SFL ;OTHERWISE REPROCESS IT NORMALLY
JRST LLOP1
LNMM: PUSH P,O ;SAVE COUNT
MOVE FS,EFSPNT
TLZ RELEF!REUNBF ;CLEAR FLAGS
RVALUA
PUSHJ P,REDUC ;REDUCE TO VALUE
POP P,FS ;GET POINTER
TLNE RELEF ;RELOC ERROR?
ERROR[ASCIZ/RELOCATION ERROR/]
SKIPGE NA,(FS) ;DEFINED?
JRST [ ERROR[ASCIZ/UNDEFINED VALUE AFTER_/]
MOVEI NA,;THIS IS TO FIX MYSTERIOUS BUG
JRST .+1]
TLZE NA,DEFFL ;DEFINED?
JRST .-2 ;NO , ERROR
MOVE N,-1(FS) ;GET VALUE
POP P,O ;GET COUNT
LLOP2: POP P,L ;GET FLAGS
POP P,PN ;GET POINTER
SKIPE XCRFSW
CREF6 1,(PN)
PUSHJ P,LABINS ;INSERT DEFINITION
SKIPE XCRFSW
JRST [MOVEI L,2
SKIPE LISTSW
IDPB L,CREFPT
JRST .+1]
SOJG O,LLOP2 ;COUNT, DONE?
EXCH N,WRD
EXCH NA,WRD+1
PUSHJ P,LBLOUT ;LIST VALUE
MOVEM N,WRD
MOVEM NA,WRD+1
POP P,N ;YES, RESTORE OPFLG ...
ANDCA N,[XWD OPFLG,0] ;...
ANDCM N ;...
SETZM DBLUP ;FLUSH ARROWS THAT ARE LURKING
JRST MEVAL
;SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO
IXTST: TLO OPFLG
PUSHJ P,SCANS ;SEE WHAT FOLLOWS
TRNE B,RTPF
TLNE SCFL
JRST IXTST2 ;SPEC CHR AFTER ( OR NOT ) AFTER THAT
PUSHJ P,SCAN1A
TLNE B,ARFL
JRST IXTST3 ;ARITH OP AFTER )
TLO PAWF ;HURRAY, IT'S AN INDEX
TLNE B,SPFL
JSR SPCSKP ;MAKE SURE WE'RE PAST BLANK
TLNE NA,DEFFL
TLO UNDF
POPJ P, ;SEE HOW EASY THAT WAS
;HERE WE SIMULATE HAVING GOTTEN THIS FAR INTO REVAL
IXTST2: TLZ RELEF!REUNBF
MOVE FS,EFSPNT
PUSH P,[16]
PUSHJ P,LFTP2
JRST NONSM2
;HERE WE SIMULATE HAVING GOTTEN EVEN FARTHER INTO REVAL
IXTST3: TLZ RELEF!REUNBF
MOVE FS,EFSPNT
PUSH FS,N
PUSH FS,NA
MOVEI O,(FS)
PUSH P,[16]
PUSHJ P,PARAR
JRST NONSM2
POLFIX: MOVE T,MTBPNT ;GET NEXT FREE AREA
MOVE N,OPCNT ;GET FIXUP LOCATION
LEG MOVEM N,2(T) ;DEPOSIT
MOVE O,OPCNT+1 ;GET FLAGS
LEG MOVEM O,3(T) ;DEPOSIT
TLNN O,INCF ;IN CORE?
JRST NOINCF ;NO
TLNE MLFT ;LEFT HALF?
JRST [HRROM T,2(N);YES -- SET REVERSE PNTR
JRST NOINCF]
HRROM T,(N) ;SET REVERSE POINTER
NOINCF: SETZM 1(T) ;CLEAR COUNT
HRRO O,T ;GET STRT POINTER
ADDI T,5 ;INCREMENT POINTER
PUSHJ P,POLMOV ;MOVE POLISH
SUBI T,1
MOVEM T,MTBPNT ;UPDATE FREE AREA POINTER
SUBI T,(O) ;FORM LENGTH
TLNE MLFT ;LEFT HALF?
TLO T,1 ;YES
TRNE FLFXF ;FULL WORD FIXUP?
TLO T,2 ;YES
MOVSM T,(O) ;DEPOSIT
SETZB N,NA ;"VALUE" IS 0
SKIPE 1(O) ;NO UNDEFS?
POPJ P,
MOVE T,3(O) ;GET FIXUP LOC FLAGS
TLNE T,INCF ;IN CORE?
POPJ P, ;YES
MOVE T,POLPNT ;GET CURRENT POINTER
MOVEM T,1(O) ;PUT IN...
HRRZM O,POLPNT ;CHAIN..
POPJ P,
POLMOV: SKIPL N,(FS) ;OPERATOR OR OPERAND?
JRST OPRD ;OPERAND
LEG MOVEM N,(T) ;DEPOSIT
TLNE N,UNOF ;UNARY OP?
JRST UNPT ;YES
MOVE N,-1(FS) ;GET POINTERS
ADDI T,2 ;INCREMENT POINTER
LEG MOVSM T,-3(T) ;DEPOSIT FIRST POINTER
PUSH P,T ;SAVE NEW POINTER
PUSH P,N ;SAVE OLD POINTER
HLRZ FS,N ;SET NEW OLD POINTER
PUSHJ P,POLMOV ;PUT IN FIRST OPERAND
POP P,FS ;GET LEFT OPERAND OLD POINTER
POP P,N ;GET OLD NEW POINTER
HRRM T,-3(N) ;DEPOSIT NEW LEFT POINTER
JRST POLMOV ;MOVE LEFT OPERAND
UNPT: MOVE N,-1(FS) ;GET OPERANDS
ADDI T,2
LEG MOVSM T,-3(T) ;DEPOSIT NEW POINTER
HLRZ FS,N ;SET UP POINTER
JRST POLMOV
OPRD: TLNN N,DEFFL ;DEFINED?
JRST DEFND ;YES
LEG MOVEM N,(T) ;DEPOSIT FLAGS
MOVE N,-1(FS) ;GET "VALUE"
LEG MOVEM N,-1(T) ;DEPOSIT
MOVE NA,O ;GET STRT OF POLFIX
HRLI NA,-1(T) ;GET POINTER
EXCH NA,4(N) ;INSERT POLFIX IN CHAIN
LEG MOVEM NA,1(T) ;...
ADDI T,3 ;INCREMENT
AOS 1(O) ;COUNT UNDEF SYMBOL
POPJ P,
DEFND:
LEG MOVEM N,(T) ;DEPOSIT FLAGS
MOVE N,-1(FS) ;GET VALUE
LEG MOVEM N,-1(T) ;DEPOSIT
ADDI T,2 ;INCR. POINTER
POPJ P,
BEND
BEGIN LABINS
COMMENT +
LABINS -- CALL, TO DEFINE A LABEL, WITH THE VALUE
IN N & NA, THE POINTER TO THE TABLE ENTRY IN
PN AND FLAGS (AS FOLLOWS) IN L (LH SAME AS IN SYM)
RH: TP1F -- DOWN-ARROW
TP2F -- ^
LH: DBLF -- __ OR ::
COLONF -- : TYPE (ERR ON REDEF)
INTF -- ==: OR =: OCCURRED SET INTERNAL
DBLUPF -- ^^ OCCURRED IN SYMBOL
+
^^LVDEF:
MOVEI L, ;HERE TO DEFINE LITERALS & VARIABLES
MOVSI T,UDSF!VARF
ANDCAB T,2(PN)
^^LABINS:
HLLZ T,L
IOR T,2(PN) ;GET FLAGS
TLNE L,DBLUPF ;WAS ^^ SEEN?
SETOM DBLUP ;YES. MARK IN CORE CELL TOO.
TLZE T,EXTF
TLO T,INTF ;TURN EXTERNAL INTERNAL IF DEFINED
TLNE T,UDSF ;UNDEFINED - DEFINED
JRST ERR ;YES
TLZN T,DEFFL ;DEFINED?
JRST DEFD ;YES
TRNE L,TP1F ;DOWN-ARROW?
OR T,DBLCK
TRNE L,TP2F ;^?
TLO T,UPARF ;YES
SKIPE DBLUP
TLO T,DBLUPF ;DOUBLE UP ARROW FLAG.
TLNE NA,INCF ;IN CORE VALUE
JRST LILHN ;YES
MOVEM T,2(PN)
EXCH N,3(PN) ;SWITCH VALUE WITH FIXUP POINTER
EXCH NA,4(PN) ;SWITCH VALUE FLAGS WITH POLFIX PNTR.
SKIPE N ;SKIP IF NO FIXUPS
PUSHJ P,GFIX ;DO FIXUPS.
MOVE N,NA
SKIPE NA ;SKIP IF NO POLFIXES.
PUSHJ P,PFIX ;DO POLFIXES
MOVE N,3(PN) ;RESTORE N ...
MOVE NA,4(PN) ;AND NA
MOVE T,2(PN) ;GET FLAGS
TLNN T,SYMFIX ;SEE IF SYMBOL TABLE FIXUP NEEDED
POPJ P, ;NO
MOVE FS,1(PN) ;BLOCK NAME
PUSHJ P,R5CON
MOVEM FS,SYMFXP+5
MOVE FS,(PN) ;SYMBOL NAME
PUSHJ P,R5CON
MOVEM FS,SYMFXP+4
MOVE N,3(PN)
HLRM N,SYMFXP+2 ;VALUE IN 2 HALVES
HRLM N,SYMFXP+3
DPB NA,[POINT 1,SYMFXP+1,2] ;RELOC
LSH NA,-2
DPB NA,[POINT 1,SYMFXP+1,1]
POUT 6,SYMFXP
MOVE NA,4(PN) ;GET RELOC BACK
POPJ P,
^SYMFXP: 11,,4 ;SYMBOL TABLE FIXUPS
0 ;RELOC BITS FOR SYMBOL VALUE
1,,0 ;OPERAND,,LEFT HALF
0,,-6 ;RIGHT HALF,,FULL-WORD SYMBOL STORE OPERATOR
0 ;R50 SYMBOL NAME
0 ;R50 BLOCK NAME
LILHN: TLO T,DEFFL!UDSF ;MARK AS UNDEFINED - DEFINED
^MAKLL: MOVEM T,2(PN) ;DEPOSIT FLAGS
GFST T,FSTPNT
MOVE FS,LABLTP ;GET POINTER TO LIST OF LIT. LABS
EXCH FS,1(T) ;CONS ON
MOVEM FS,FSTPNT
MOVEM T,LABLTP
MOVE FS,(PN) ;GET SIXBIT
MOVEM FS,(T) ;DEPOSIT
MOVE FS,LABLTC ;GET COUNT
MOVEM FS,3(T) ;DEPOSIT
MOVEM PN,4(T) ;THE LOCATION OF THE SYMBOL BLOCK
POPJ P,
;GFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND
; FIRST FIXUP POINTER IN N. USES T,FS,L,TAC
^GFIX: MOVSI T,REFBIT
IORM T,2(PN) ;MUST BE REFERENCED IF FIXUP NEEDED
LOOP1: MOVE FS,4(PN) ;GET FLAGS
MOVE TAC,2(N) ;GET FIXUP FLAGS
MOVE L,4(N) ;GET VALUE FLAGS
MOVE T,3(PN) ;GET VALUE
ADD T,(N) ;ADD DEVIATION
TRNE TAC,2 ;FULL WORD?
JRST FULFX ;YES
DPB L,[POINT 1,FS,34];SET LEFT HALF RELOC BIT
HRL T,3(N) ;PUT IN POINTER
TLNE L,INCF ;IN CORE?
JRST INCFX ;YES
TRNN TAC,1 ;LEFT HALF?
JRST .+4 ;NO
CAML FC,[-1,,0]
PUSHJ P,BFFRC ;FORCE BINARY AND FIXUPS: DON'T SEND -1 AS LAST WORD
FOUT LFX ;SEND -1 SIGNIFYING LEFT HALF FIXUP
FOUT T ;OUTPUT FIXUP
LOOP2: MOVE L,FSTPNT ;RETURN TO FREE STORAGE
EXCH L,1(N) ;LINK TO NEXT FIXUP INTO L
MOVEM N,FSTPNT
SKIPE N,L ;GET NEXT, DONE?
JRST LOOP1 ;DO MORE.
POPJ P,
FULFX: TLNE L,INCF ;IN CORE?
JRST FINCFX ;YES
HRLM T,FULF+3 ;DEPOSIT VALUE
HLRM T,FULF+2 ;...
DPB FS,[POINT 1,FULF+1,2];DEP. RELOC.
LSH FS,-2
DPB FS,[POINT 1,FULF+1,1];...
MOVE T,3(N) ;GET FIXUP PLACE
HRLM T,FULF+4 ;DEPOSIT
DPB L,[POINT 1,FULF+1,4];DEP. RELOC.
PUSHJ P,BFRC ;FORCE OUT BIN
POUT 5,FULF ;OUTPUT POLFIX
JRST LOOP2
LFX: -1 ;WORDS FOR LEFT HALF FIXUP
0
FULF: XWD 11,3 ;FULLWORD FIXUPS
0
XWD 1,0
XWD 0,-3
0
FINCFX: MOVE TAC,3(N) ;GET PLACE FULL-WORD IN-CORE FIXUP
MOVEM T,3(TAC) ;DEPOSIT VALUE...
ORM FS,4(TAC) ;& RELOC.
SETZM (TAC)
JRST LOOP2
INCFX: TRNE TAC,1 ;LEFT HALF?
JRST LINCFX ;YES
MOVS TAC,T ;RIGHT-HALF INCORE FIXUP
HRRM T,3(TAC) ;DEPOSIT VALUE
DPB FS,[POINT 1,4(TAC),35];DEPOSIT RELOC.
SETZM (TAC) ;ZERO REVERSE POINTER
JRST LOOP2
LINCFX: MOVS TAC,T ;LEFT-HALF INCORE FIXUP
HRLM T,3(TAC) ;DEPOSIT VALUE
DPB FS,[POINT 1,4(TAC),33];DEPOSIT RELOC.
SETZM 2(TAC) ;ZERO REVERSE POINTER
JRST LOOP2
DAREDF: MOVE FS,BLOCK ;GET BLOCK BIT
TRNE L,TP2F
LSH FS,-1
SKIPE DBLUP
MOVEI FS,1
SUBI FS,1 ;FORM ALL HIGHER BLOCK BITS
AND FS,T ;ANY HIGHER LEVEL BITS ON
JUMPE FS,DEFD1 ;NO
SKIPE XCRFSW
JRST [MOVEI FS,7
SKIPE LISTSW
IDPB FS,CREFPT
JRST .+1]
PUSHJ P,MKNEW ;CREATE A NEW ENTRY
ERROR [ASCIZ /WARNING - DOWN-ARROWED SYMBOL REDEFINED/]
JRST LABINS
DEFD: TLNE T,DAF ;DOWN ARROW?
JRST DAREDF ;YES
DEFD1: TLZ T,UPARF ;CLEAR UPARROW BIT
TLNN T,COLONF
TLNE L,COLONF
JRST CHKDEF ;PROBABLY ERR IF EITHER NEW OR OLD IS : TYPE
DEFOK: TRNE L,TP1F ;DOWN-ARROW?
OR T,DBLCK
TRNE L,TP2F ;^?
TLO T,UPARF ;YES
SKIPE DBLUP
TLO T,DBLUPF
MOVEM T,2(PN) ;STORE FLAGS
MOVEM N,3(PN) ;DEPOSIT VALUE
MOVEM NA,4(PN) ;...
POPJ P,
CHKDEF: CAMN N,3(PN)
CAME NA,4(PN)
JRST ERR
JRST DEFOK ;NOT ERR IF REDEF WITH SAME VAL
ERR: ERROR[ASCIZ/MULTIPLE DEFINITION/]
POPJ P,
;PFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH
; FIXUP CHAIN POINTER IN N. USES T,FS,TAC,L
^PFIX: MOVSI T,REFBIT
IORM T,2(PN) ;INDICATE REFERENCED
PFIX1: MOVS T,N ;GET OPERAND POINTER
MOVE FS,3(PN) ;GET VALUE
MOVEM FS,(T) ;DEPOSIT
MOVE FS,4(PN) ;GET FLAGS
MOVEM FS,1(T) ;DEPOSIT
MOVE FS,2(T) ;SAVE NEXT...
MOVEM FS,T2SAV ;POINTER
SOSLE 1(N) ;DECREMENT UNDEF SYM COUNT
JRST SUL ;Some Undefs. Left
MOVEI FS,5(N) ;GET START OF POLISH
PUSH P,O ;SAVE O
PUSHJ P,REDUC ;REDUCE
POP P,O ;RESTORE O
SKIPGE FS,5(N) ;VALUE OR OPERATOR?
JRST PLOUT ;OPERATOR
MOVE L,3(N) ;GET FIXUP FLAGS
TLNE L,INCF ;IN CORE FIXUP?
JRST PINC ;YES
MOVE TAC,(N) ;GET LEFT HALF FLAG
TRNE TAC,2 ;FULL WORD?
JRST PFULX ;YES
TRNN TAC,1 ;LEFT HALF?
JRST .+4 ;NO
CAML FC,[-1,,0]
PUSHJ P,BFFRC ;FORCE BINARY AND FIXUPS NOW. (AVOID SENDING -1 AS LAST WORD)
FOUT LFX ;SEND -1 SIGNIFYING LEFT HALF FIXUP
MOVE T,4(N) ;GET VALUE
HRL T,2(N) ;GET FIXUP
DPB L,[POINT 1,FS,34];DEPOSIT FIXUP RELOC
FOUT T ;PUT OUT FIXUP
PPT1: PUSH P,B ;SAVE
PUSH P,C
HRRZ C,N ;GET START ADDRESS
HLRZ B,(N) ;GET LENGTH
ADD B,C ;GET END
PUSHJ P,MACRET ;RETURN SPACE
POP P,C ;RESTORE
POP P,B
SUL: SKIPE N,T2SAV ;GET NEXT POLFIX
JRST PFIX1
POPJ P, ;NO MORE
PFULX: MOVE T,4(N) ;GET VALUE
HLRM T,FULF+2 ;DEPOSIT
HRLM T,FULF+3 ;...
DPB FS,[POINT 1,FULF+1,2];DEPOSIT RELOC
LSH FS,-2
DPB FS,[POINT 1,FULF+1,1]
MOVE T,2(N) ;GET FIXUP
HRLM T,FULF+4 ;DEPOSIT
DPB L,[POINT 1,FULF+1,4];DEPO. RELOC
PUSHJ P,BFRC ;FORCE OUT BIN
POUT 5,FULF ;PUT OUT FIXUP
JRST PPT1
PINF: MOVE T,4(N) ;GET VALUE
MOVE TAC,2(N) ;GET LIT LOC
MOVEM T,3(TAC) ;DEPOSIT VALUE
ORM FS,4(TAC) ;DEPOSIT RELOC
SETZM (TAC)
JRST PPT1
PINC: MOVE TAC,(N) ;GET FLAGS
TRNE TAC,2 ;FULL WORD?
JRST PINF ;YES
TRNE TAC,1 ;LEFT HALF?
JRST PINCL ;YES
MOVE TAC,2(N) ;GET LIT LOC.
MOVE T,4(N) ;GET VALUE
HRRM T,3(TAC) ;DEPOSIT
SETZM (TAC) ;CLEAR REVERSE POINTER
DPB FS,[POINT 2,4(TAC),35];DEP RELOC.
JRST PPT1
PINCL: MOVE TAC,2(N) ;GET LIT LOC.
MOVE T,4(N) ;GET VALUE
HRLM T,3(TAC) ;DEPOSIT
SETZM 2(TAC) ;CLEAR REV. PNTR.
DPB FS,[POINT 2,4(TAC),33];DEP RELOC.
JRST PPT1
HALOUT: HRROM L,HALP1 ;DEPOSIT RIGHT HALF OF POINTER
SETCMM HALP1 ;AND COMPLEMENT IT
IBP L ;INCREMENT RELOC POINTER
TDNE L,HALP1 ;DID IT GO TO NEXT WORD?
JRST HALP2 ;YES
HALRET:
LEG IDPB TAC,HALP3 ;DEPOSIT HALFWORD
MOVSS TAC
LEG DPB TAC,L ;DEPOSIT RELOC
AOS HALP4 ;COUNT
POPJ P,
HALP2: ADDI L,=18 ;INCREMENT RELOC POINTER
AOS HALP3 ;INCREMENT HALFWORD POINTER
JRST HALRET
T2SAV: 0
HALP1: 0
HALP3: 0
HALP4: 0
PLOUT: MOVE L,3(N) ;GET FIXUP FLAGS
TLNE L,INCF ;IN CORE?
JRST SUL ;YES
MOVEI FS,5(N)
PUSHJ P,POLOUT
JRST PPT1
^POLOUT:
HRRZ L,MTBPNT ;GET A FREE PLACE TO PUT FIXUP
PUSH P,N ;SAVE N
ADD L,[XWD 442200,2] ;MAKE HALFWORD POINTER
SETZM HALP4 ;ZERO COUNT
MOVEM L,HALP3 ;DEPOSIT
ADD L,[440100000001-442200000002] ;MAKE RELOC POINTER
PUSHJ P,PPFFXX ;DO FIXUP
POP P,N ;GET N
HRRZ T,(N) ;GET FLAGS
MOVN TAC,T ;FORM...
ADDI TAC,-1 ;STORE OP
PUSHJ P,HALOUT ;OUTPUT IT
MOVE TAC,2(N) ;GET FIXUP
HRL TAC,3(N) ;& RELOC
PUSHJ P,HALOUT ;OUTPUT IT
MOVE T,MTBPNT ;GET START
MOVE FS,HALP4 ;GET COUNT
ADDI FS,1
LSH FS,-1 ;FORM REAL COUNT
HRLI FS,11 ;BLOCK TYPE
LEG MOVEM FS,(T) ;DEPOSIT
PUSHJ P,BFRC ;FORCE OUT BINARY
MOVN TAC,HALP3 ;FORM...
ADDI TAC,-1(T) ;LENGTH
HRL TAC,T ;GET START
MOVSM TAC,HALP3
BBOUT HALP3
POPJ P, ;RETURN
PPTT1: MOVS FS,-1(FS) ;GET ARG POINTER
PPFFXX: SKIPL T,(FS) ;OPERAND OR OPERATOR?
JRST POPND ;OPERAND
DPB T,[POINT 5,T,4] ;CALUCULATE OPERATOR INDEX
LDB T,[POINT 7,T,6] ;INCLUDE MODIFIER BITS
LDB TAC,[POINT 12,OPTB1-10(T),11] ;CONVERT INDEX TO LOADER'S FORMAT
JUMPN TAC,.+2
ERROR [ASCIZ/UNKNOWN OPERATOR IN EMISSION OF POLISH FIXUP/]
PUSHJ P,HALOUT ;PUT OUT OPERATOR
MOVE T,(FS)
TLNE T,UNOF ;UNARY OP?
JRST PPTT1 ;YES
MOVE FS,-1(FS) ;GET FIRST ARG POINTER
PUSH P,FS ;SAVE
PUSHJ P,PPFFXX ;PUT OUT
MOVS FS,(P) ;GET SECOND ARG POINTER
SUB P,[1(1)]
JRST PPFFXX ;PUT OUT & RETURN
POPND: TLNE T,DEFFL ;DEFINED?
JRST POPUN ;NO
MOVE TAC,-1(FS) ;GET VALUE
TLNN TAC,-1 ;SHORT OR LONG WORD?
TRNE T,14 ;LEFT RELOC?
JRST POPLNG ;LONG
MOVEI TAC, ;GET FLAGS
PUSHJ P,HALOUT ;PUT OUT
MOVE TAC,-1(FS) ;GET WORD
DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
JRST HALOUT ;PUT OUT HALFWORD & RETURN
POPLNG: LDB N,[POINT 2,T,32];GET LEFT RELOC
MOVEI TAC,1
PUSHJ P,HALOUT
MOVS TAC,-1(FS)
HRL TAC,N
PUSHJ P,HALOUT ;PUT OUT LEFT HALF
HRRZ TAC,-1(FS) ;GET RIGHT HALF
DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
JRST HALOUT ;PUT IT OUT & RETURN
POPUN: MOVEI TAC,2
PUSHJ P,HALOUT
MOVE N,-1(FS) ;GET POINTER
MOVE FS,(N) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO RADIX50
TLO FS,40000 ;MARK AS EXTERNAL (POLISH TYPE)
HLRZ TAC,FS ;PUT OUT LEFT HALF
PUSHJ P,HALOUT
HRRZ TAC,FS ;PUT OUT RIGHT HALF...
JRST HALOUT ;AND RETURN
BEND LABINS
SUBTTL ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE
; CALLED IN A STRANGE FASHION BECAUSE IT IS
; RECURSIVE AND A CO-ROUTINE
BEGIN ASSMBL
^NONEM__10 ;TEMP BIT USED TO MAKE NONZERO INDICATION
^RBARET:TRO TRBF ;TERM BY ]
TRNE NOFXF ;NO FIXUPS?
JRST ARET ;YES, DONT LIST
SKIPE WRD+1
PUSHJ P,BLOUT
^ARET: RETN
^ASSMBL:TDZ[XWD OPFLG!AUNDF,ADFL!TRBF!IOSW]
SETZM WRD ;CLEAR WRD
SETZM WRD+1
LOOP1:
LOOP2: SKIPN WRD+1 ;EMPTY SO FAR?
TRO FLFXF ;YES, TELL MEVAL TO GENERATE FULL WORD FIXUPS
PUSHJ P,MEVAL ;GET NEXT THING
TRZ FLFXF
TLNE SOPF ;OPCODE?
JRST OPCD ;YES
TLNE ESPF ;SPC CHR?
JRST SPCL ;YES
TLNE PAWF ;()?
JRST IXFLD ;YES
TRNE B,COMF ;TERM BY ,?
JRST ACFLD ;YES
TROE ADFL ;ALREADY GOT AN ADDRESS?
JRST LERRA ;YES
TLNE UNDF ;DEFINED?
TLO AUNDF ;NO
SKIPN WRD+1 ;ANYTHING YET?
JRST EMP ;NO
HRRM N,WRD ;DEPOSIT AS ADDRESS
ANDI NA,1 ;GET RELOCATION
LOOP69: ORM NA,WRD+1 ;DEPOSIT
JRST LOOP2
EMP: MOVEM N,WRD ;DEPOSIT VALUE
HLL NA, ;GET AUNDF FLAG (MEANS FW FIXUP GENERATED)
AND NA,[AUNDF,,5] ;ISOLATE FLAG & RELOCATION
TLO NA,NONEM ;SET "NON EMPTY"
MOVEM NA,WRD+1 ;DEPOSIT
JRST LOOP2
LERRA: ERROR[ASCIZ/TWO ADDRESS FIELDS OR UNDEF OPCODE/]
JRST LOOP1 ;NO OR NO
OPCD: SKIPN XCRFSW ;CREF?
JRST OPCD2
MOVE FS,1(PN) ;PN STILL POINTS TO ENTRY, GET FLAGS
JUMPL FS,ORDOP
TLNN FS,20 ;IS IT REGULAR TYPE?
JRST ORDOP ;YES
HRRZ FS,2(PN) ;BLOCK BITS
JUMPE FS,ORDOP
CREF6 5,(PN) ;OPDEF, PUT OUT AS MACRO
SKIPA
ORDOP: CREF7 3,L ;YES
OPCD2: TLNE PSOPF ;PSEUDO OP?
JRST (NA) ;YES
^OPCDR: MOVEM N,WRD ;DEPOSIT IN WRD
TLO NA,NONEM ;SET NON-EMPTY
MOVEM NA,WRD+1 ;DEPOSIT
TRNE N,-1
TRO ADFL ;TO WARN ABOUT MISUSED CALLIS
JRST LOOP2
IXFLD: TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEFINED INDEX FIELD/]
MOVSS N
TRNE N,-1 ;RIGHT HALF ZERO?
TRON ADFL ;GOT AN ADDRESS?
JRST IXFLD1 ;NO ADDRESS YET, OR RIGHT HALF IS ZERO
TRZ N,-1
ERROR [ASCIZ/INDEX EXPRESSION WAS TRUNCATED TO AVOID CLOBBERING ADDRESS FIELD/]
IXFLD1: ORM N,WRD ;OR INTO WRD
TRZE NA,17 ;RELOC?
ERROR [ASCIZ/RELOCATABLE INDEX FIELD/]
TLOA NA,NONEM ;SET "NON-EMPTY"
ACFL2: DPB N,[270400,,WRD] ;STORE AC FIELD
ACFL3: ORB NA,WRD+1 ;OR IN, GET OLD FLAGS
TLNE NA,AUNDF
ERROR [ASCIZ /AC OR INDEX FIELD CLOBBERED BY FIXUP/]
JRST LOOP1
ACFLD: PUSHJ P,SCAN1A ;GET NEXT
TRNE B,COMF ;ANOTHER ,?
JRST CCOM ;YES
TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEFINED AC FIELD/]
TRZE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC AC FLD/]
TLO NA,NONEM ;SET "NON-EMPTY"
TRNN IOSW ;IO OP?
JRST ACFL2 ;NO
LSH N,-2
DPB N,[POINT 7,WRD,9]
JRST ACFL3
CCOM: TLZ SFL ;SKIP THE ,
SKIPE WRD+1 ;ANYTHING ASSEMBLED YET?
ERROR [ASCIZ /ILLEGAL ,,/] ;YES -- COMPLAIN
TLNN UNDF ;UNDEFINED?
JRST CCOM2 ;NO. JUST STORE VALUE.
TLO AUNDF ;YES -- TELL SOMEONE
JUMPL O,CCPOL ;JUMP IF WE HAVE SCREWED POLISH FIXUPS.
MOVE T,4(O) ;NO WE DID A REGULAR FIXUP
JUMPE NA,CCFOK ;JUMP IF WE CREATED A NEW FIXUP
CCOM0: MOVEM N,3(O) ;RESTORE
MOVEM NA,4(O) ;OLD VALUE & FLAGS
MOVE NA,(O) ;LINKED TO WRONG THING -- GET OFFSET
TLO MLFT ;LET'S DO IT LEFT THIS TIME
PUSHJ P,CCFIX ;HAVE TO DO THIS OVER AGAIN
TLZ MLFT ;STOP DOING LEFT HALF FIXUPS, FRED - REG/JBR
JRST CCOM2 ;NOW FINISH
CCFOK: JUMPN N,CCOM0 ;IN ABS ASSEMBLY, NEED TO TEST N TOO.
;JUMP IF THAT WASN'T A NEW FIXUP
MOVEI T,1 ;LH ONLY
DPB T,[(200)2(O)] ;FIX FLAGS
MOVE T,4(O) ;SEE IF
TLNN T,INCF ;IN CORE?
JRST CCOM2 ;NO -- OK
MOVE T,3(O) ;YES -- WHERE?
CCRFX: SETZM (T) ;NO LONGER RH
MOVEM O,2(T) ;NOW LH REV PNTR
JRST CCOM2 ;NOW STORE
CCPOL: MOVEI T,1 ;LH ONLY
DPB T,[(200+O)] ;FIX FLAGS IN FIXUP
MOVE T,3(O) ;SEE WHAT IT'S FOR
TLNN T,INCF ;SOMETHING IN CORE?
JRST CCOM2 ;NO -- ALL DONE
MOVE T,2(O) ;YES -- FIND OUT WHERE
JRST CCRFX ;NOW FIX REV PNTRS
CCOM2: HRLM N,WRD ;STORE LH
DPB NA,[20200,,NA] ;MOVE RELOC BITS
TRZ NA,3 ;& FLUSH FROM RH
TLO NA,NONEM ;SOMETHING THERE
TLO OPFLG ;STOP OPCODE LOOKUP
JRST LOOP69 ;SET FLAGS & GO ON
SPCL: TLNE N,CRFG!LNFD;CR?
JRST SCR ;YES
TRNE N,ATF ;@?
JRST SAT
TLNE N,RBRF ;> OR ]?
JRST RBARET ;YES, RETURN
MOVSI NA,NONEM ;PREPARE TO MAKE NON-EMPTY
TRNE N,COMF ;IF COMMA
JRST LOOP69 ;CAUSE 18-BIT TRUNCATION
ERROR[ASCIZ/UNREC SPC CHR/]
JRST LOOP1
^ASCR:
SCR: TRNE NOFXF ;NO FIXUPS TO BE GEN'D?
JRST .+3 ;YES, DON'T LIST BINARY
SKIPE WRD+1 ;ANYTHING?
PUSHJ P,BLOUT ;YES, DEPOSIT BINARY
TLNN N,LNFD ;LINE FEED?
PUSHJ P,SCNTIL ;NO, SKIP TO IT
JRST ARET
SAT: MOVSI N,20 ;GET @ BIT
MOVSI NA,NONEM ;GET NON-EMPTY BIT
ORM N,WRD ;DEPOSIT
ORM NA,WRD+1 ;...
JRST LOOP1
BEND ASSMBL
BEGIN POPS SUBTTL PSEUDO-OP ROUTINES ;BLOCK, HISEG, TWOSEG
^%BLOCK:MOVE N,OPCNT+1 ;ILLEGAL IN LIT
TLNE N,INCF
JRST PSLIT
TRO NOFXF ;NO FIXUPS IF UNDEF
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC. CHR?
JRST BERR ;YES
JUMPGE N,.+2
ERROR [ASCIZ/NEGATIVE ARGUMENT TO BLOCK/]
PUSHJ P,BFFRC ;FORCE OUT BINARY AND THEN FIXUPS
ADDM N,PCNT ;ADD TO LOC CNTRS
ADDM N,OPCNT ;....
HRRZS PCNT
HRRZS OPCNT
SETZM WRD+1
SOS OPCNT
PUSHJ P,VBLOUT
AOS OPCNT
MOVE N,OPCNT
CAMGE N,BRK ;HIGH SEGMENT?
JRST .+5 ;NO,LOW SEG
CAMGE N,HICNT ;YES, IS OPCNT HICNT?
JRST .+5 ;NO
MOVEM N,HICNT ;YES,INCREMENT HIGH
JRST .+3
CAML N,@CURBRK ;IS OPCNT LOCNT?
MOVEM N,@CURBRK ;YES,INCREMENT LOW
JRST SPCFN
BERR: ERROR[ASCIZ/NOT EXPRESSION AFTER BLOCK/]
SETZM WRD+1
JRST SPCFN
^%HISEG:SETZM WRD+1
SETOM SEG
MOVEI N,400000
MOVEM N,OPCNT
MOVEM N,PCNT
MOVEM N,DPCNT
HRRM N,HIBLK+2
MOVEI N,1
MOVEM N,OPCNT+1
MOVEM N,PCNT+1
MOVEM N,DPCNT+1
SETZM BRK
POUT 3,HIBLK
JRST SPCFN
HIBLK: XWD 3,1
XWD 200000,0
XWD 400000,400000
^%TWOSEG:TRO NOFXF
SETOM SEG
PUSHJ P, MEVAL
MOVEM N,NA
SETZM WRD+1
TLNE ESPF ;ARGUMENT?
MOVEI N,400000 ;NO
TLNE UNDF ;YES. DEFINED?
JRST TWOERR ;NO. ERROR
HRRZM N,BRK
HRRM N,HIBLK+2
POUT 3,HIBLK ;YES
MOVE N,NA
TLNN ESPF
JRST SPCFN
JRST NSPCFN
TWOERR: ERROR[ASCIZ/TWOSEG ARGUMENT UNDEFINED./]
JRST SPCFN
; ASCII, ASCIZ, ASCID, .TEXT SPCFN,SCR
TM1: 0
^%ASCII:
TLZ SFL ;CLEAR SCAN AHEAD
MOVEM N,TM1 ;SAVE VALUE (-1=ASCID,0=ASCII,1=ASCIZ,2=.TEXT)
HRRM C,TM2 ;SAVE TERM CHR.
HRRM C,TXM2 ;SAVE TERM CHR FOR TEXT TOO.
;IN CASE OF ACCIDENT, WE SAVE WHERE WE STARTED.
SKIPN C,TLBLK ;GET SOS LINE NUMBER
HRRO C,INLINE ;NONE. USE OUR COUNT
MOVEM C,TXLIN ;SAVE AS LINE NUMBER WHERE TEXT PSEUDO-OP BEGINS
MOVE C,PGNM ;GET PAGE NUMBER
MOVEM C,TXTPG ;SAVE PAGE WHERE TEXT PSEUDO-OP BEGINS
NOTNX,< MOVE C,[FILNM,,TXTFIL]
BLT C,TXTFIL+4 ;SAVE CURRENT FILE NAME >;NOTNX
TNX,< MOVE C,JFNTBL
MOVEM C,TXTFIL ;JFN OF THE FILE >;TNX
CAIN N,2 ;.TEXT?
JRST TXLP2 ;YES.
LOOP2: MOVEI N, ;CLEAR
MOVEI NA,5 ;COUNT
LOOP1: PUSHJ P,SCAN1 ;GET CHR.
TM2: CAIN C,0-0 ;TERM CHR?
JRST FND ;YES
LSH N,7 ;NO,SHIFT
OR N,C ;AND INSERT
SOJG NA,LOOP1 ;5 CHRS?
LSH N,1 ;YES
SKIPGE TM1 ;ASCID?
ORI N,1 ;YES
MOVEM N,WRD ;DEPOSIT VALUE
MOVSI N,NONEM ;PREPARE FLAGS
MOVEM N,WRD+1 ;DEPOSIT
PUSHJ P,BLOUT ;LIST BINARY
RETN ;COROUTINE RETURN
JRST LOOP2 ;CONTINUE
FND: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP
CAIN NA,5 ;NONE IN THIS WORD?
JRST NONW ;YES, NONE
LSH N,7 ;ADJUST
SOJG NA,.-1 ;...
LSH N,1
SKIPGE TM1 ;ASCID?
ORI N,1 ;YES
MOVEM N,WRD ;DEPOSIT VALUE
LOP1: MOVSI N,NONEM
MOVEM N,WRD+1 ;SET FLAGS
^SPCFN: TRZ NOFXF
PUSHJ P,SCAN1 ;GET CHR.
TLNN B,CRFG!RBRF ;CR, OR ], OR >?
JRST SPCFN ;NO
TLNE B,CRFG ;CR?
JRST SCR ;YES.
TLO SFL ;SET SCANNER AHEAD TO RESCAN ] OR >
PUSHJ P,SCAN ;EXIT SCAN VIA SPCRET, DOING GOOD THINGS
JRST RBARET ;RETURN FROM ASSMBL FOR ] OR >
^SCR: SKIPE WRD+1 ;ANYTHING?
PUSHJ P,BLOUT ;YES. LIST IT.
TLNN B,LNFD ;LF YET?
PUSHJ P,SCNTIL ;NO, GET TO IT
JRST ARET
NONW: SETZM WRD ;ZERO WORD
SKIPLE TM1 ;ASCIZ?
JRST LOP1 ;YES, RETURN 0
SETZM WRD+1 ;"NOTHING ON LINE"
JRST SPCFN ;RETURN
TXLP2: SETZB N,WRD+1 ;CLEAR AC
MOVEI NA,5 ;COUNT
TXLP1: PUSHJ P,SCAN1 ;GET CHR.
TXM2: CAIN C,0-0 ;TERM CHR?
JRST TXFND ;YES
LSH N,7 ;NO,SHIFT
IORI N,(C) ;AND INSERT
SOJG NA,TXLP1 ;5 CHRS?
TXLP3: LSH N,1 ;YES. MOVE ONE MORE
MOVEM N,WRD ;DEPOSIT VALUE
POUT 1,WRD ;WRITE THE WORD IN THE BINARY
PUSHJ P,LBLOUT ;LIST BINARY
SKIPE TM1 ;LAST TIME THRU?
JRST TXLP2 ;NO. CONTINUE
JRST SPCFN ;FLAG NOTHING IN WORD. RETURN
TXFND: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP
LSH N,7 ;ADJUST
SOJG NA,.-1 ;...
SETZM TM1 ;FLAG EXIT FROM .TEXT
JRST TXLP3
; XWD NSPCFN .RCTAB .WCTAB
^%XWD: TLO MLFT ;LEFT HALF
PUSHJ P,MEVAL
TLNE ESPF ;SPC CHR?
JRST XER ;YES - ERROR
TRNN B,COMF ;TERM BY ,?
ERROR [ASCIZ/NO COMMA AFTER XWD OR BLANK FIELD/]
TRNE NA,14 ;LEFT HALF RELOC?
ERROR [ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
PUSH P,N ;SAVE
PUSH P,NA ;SAVE
TRNE B,COMF ;IF NOT COMMA, DON'T SKIP DELIM.
PUSHJ P,SCAN ;SKIP THE ,
TLNE B,CRFG!RBRF ;NOTHING MORE?
JRST [SETZB N,NA ;NO. USE ZERO FOR RIGHT HALF.
JRST XWD3]
TLZ MLFT ;NO LONGER LEFT HALF
PUSHJ P,MEVAL
TLNE ESPF ;SPC CHR?
JRST XERQ ;YES
TRNE NA,14 ;LEFT HALF RELOC?
ERROR [ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
XWD3: TLO NA,NONEM
MOVEM N,WRD ;DEPOSIT VALUE
MOVEM NA,WRD+1
POP P,NA ;GET BITS
DPB NA,[POINT 2,WRD+1,33] ;DEPOSIT RELOC
POP P,NA ;GET VALUE
HRLM NA,WRD ;DEPOSIT
JRST SPCFN
XERQ: SUB P,[2,,2]
XER: ERROR [ASCIZ/NO EXPRESSION AFTER XWD/]
^NSPCFN:TLNN N,CRFG!RBRF ;CR RET?
JRST SPCFN ;NO
TRZ NOFXF
TLNE N,CRFG ;CR?
JRST ASCR
JRST RBARET
^%RCTAB:TRO NOFXF
PUSHJ P,MEVAL ;GET CHAR TO READ
TRNN NA,17 ;NO RELOC ALLOWED
TLNE UNDF!ESPF
JRST CHERR
ANDI N,177
MOVE N,CTAB(N)
MOVEM N,WRD
SETZM WRD+1
JRST SPCFN
CHERR2: ERROR [ASCIZ/NO COMMA IN .WCTAB/]
JRST SPCFN
CHERR3: POP P,(P)
CHERR: ERROR [ASCIZ/ILLEGAL VALUE TO CTAB/]
JRST SPCFN
^%WCTAB:TRO NOFXF
PUSHJ P,MEVAL ;GET CHAR TO SET
TRNN NA,17
TLNE UNDF!ESPF
JRST CHERR
TRNN B,COMF
JRST CHERR2
PUSH P,N ;SAVE CHAR
PUSHJ P,SCAN ;SKIP ,
TRO NOFXF
PUSHJ P,MEVAL ;VALUE TO SET IT TO
TRNN NA,17
TLNE UNDF!ESPF
JRST CHERR3
POP P,TAC
ANDI TAC,177
MOVEM N,CTAB(TAC)
JRST SPCFN
; LIT, RADIX
^%LIT: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT ;NOT IN LIT
PUSHJ P,LITOUT
SETZM WRD+1
JRST SPCFN
^%RADIX:TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC. CHR?
JRST RERR ;YES
PUSHJ P,RADX ;SET RADIX
SETZM WRD+1
JRST SPCFN
RERR: ERROR[ASCIZ/NOT EXPRESSION AFTER RADIX/]
TLNE ESPF
JRST NSPCFN
JRST SPCFN
^RADX: MOVE NA,[IMULI N,];PREPARE INSTRUCTION
HRR NA,N
CAIN N,10 ;OCTAL?
MOVE NA,[LSH N,3];YES
MOVEM NA,SRAD ;SET RADIX
MOVE NA,CTAB+"0"
ADDI NA,(N)
MOVEM NA,RTEST
POPJ P,
; DEC AND OCT, %IO - HANDLE MACHINE IO OPCODES, PSLIT
CONSVR: 0
CONSVT: 0
^%CON: MOVE TAC,SRAD ;SAVE CURRENT RADIX - OCT AND DEC
MOVEM TAC,CONSVR
MOVE TAC,RTEST
MOVEM TAC,CONSVT
PUSHJ P,RADX ;SET RADIX
MOVSI N,NONEM
MOVEM N,WRD+1
CONLOP: PUSHJ P,SCANM ;GET NUM
TLNN NFLG ;NUM?
JRST CONERR ;NO
MOVEM N,WRD ;DEPOSIT NUMBER
TRNN B,COMF ;TERM BY ,?
JRST CONLST ;NO, LAST ONE
PUSHJ P,BLOUT ;PRINT BINARY
RETN ;CO-ROUTINE WILL RETURN BELOW FOR NEXT
TLZ SFL ;SKIP THE ,
JRST CONLOP
CONERR: ERROR [ASCIZ/NOT A NUMBER/]
CONLST: MOVE TAC,CONSVR ;RESTORE RADIX
MOVEM TAC,SRAD
MOVE TAC,CONSVT
MOVEM TAC,RTEST
JRST SPCFN
^%IO: TRO IOSW ;TURN ON IO SWITCH - HARDWARE I/O MNEMONIC SEEN.
MOVEI NA, ;CLEAR OUT BITS
JRST OPCDR ;PROCEED
^PSLIT: ERROR [ASCIZ /ILLEGAL PSEUDOOP IN LITERAL/]
ADD P,[17,,17]
MOVEM 16,(P)
MOVEI 16,-16(P)
BLT 16,-1(P)
MOVE 16,(P)
MOVEI 3,LITMS
PUSHJ P,FMES ;LITERAL LINE N PAGE P FILE FOO.BAR
MOVSI 16,-16(P)
BLT 16,16
SUB P,[17,,17]
SETZM WRD+1
JRST SPCFN
; PHASE, DEPHASE, LIST, XLIST, XLIST1, COMMENT
PERR: ERROR [ASCIZ/UNDEFINED OR SPECIAL CHR/]
JRST SPCFN
^PHAZ: MOVE N,OPCNT+1 ;PHASE
TLNE N,INCF
JRST PSLIT ;NOT LEGAL IN LITERAL
TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TLNE UNDF!ESPF ;DEFINED?
JRST PERR ;NO. LOSE
MOVEM N,PCNT ;DEPOSIT VALUE...
MOVEM NA,PCNT+1 ;RELOCATION
JRST SPCFN
^DPHAZ: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
MOVE N,[XWD OPCNT,PCNT]
BLT N,PCNT+1
JRST SPCFN
^%LIST: JUMPE N,LST1 ;JUMP IF LIST
JUMPL N,LST2 ;JUMP IF XLIST
SKIPN XL1IG ;SKIP IF IGNORE XLIST1 (/I SWITCH)
LST2: SETOM XL2SW ;XLIST: TERMINATE LISTING
JRST SPCFN
LST1: SETZM XL2SW ;TERMINATE THINKING ABOUT XLIST
SKIPN LISTSW ;LISTING DEVICE EXISTS?
JRST SPCFN ;NO
TRO LDEV ;YES. START LISTING
MOVE N,LSTPNT ;GET THE LISTING BYTE POINTER
MOVEI NA,0
REPEAT 5,< IDPB NA,N > ;STUFF NULL BYTES IN
SETZM (N)
HRLI N,(N)
ADDI N,1
BLT N,LTEST-1 ;CLEAR OUT THE LISTING BUFFER
JRST SPCFN
^%COMMT: ;COMMENT
SKIPN TAC,TLBLK ;REPEAT 0
HRRO TAC,INLINE
MOVEM TAC,REPPG
MOVE TAC,PGNM
MOVEM TAC,REP0PG
NOTNX,< MOVE TAC,[FILNM,,REPFIL]
BLT TAC,REPFIL+4
>;NOTNX
TNX,<
MOVE TAC,JFNTBL
MOVEM TAC,REPFIL ;SAVE JFN OF FILE
>;TNX
PUSHJ P,SLURPC ;EAT EVERYTHING UP TO MATCHING CHAR
SETZM REP0PG
JRST SPCFN
; BYTE
^%BYTE: TRNN B,LFPF ;( NEXT?
JRST BERR1 ;NO
SETZM WRD
TRO NOFXF ;NO FIXUPS
MOVE N,[POINT 3,WRD]
MOVEM N,PNTR
PARLOP: PUSH P,SRAD ;SAVE RADIX
PUSH P,RTEST
MOVEI N,12
PUSHJ P,RADX ;CONVERT TO DEC.
PUSHJ P,MEVAL ;GET VALUE
TLNN PAWF ;()?
ERROR[ASCIZ/AMBIGUITY ERROR/]
TLNE UNDF!ESPF ;UNDEF OR SPC CHR?
ERROR[ASCIZ/UNREC OR UNDEF SIZE/]
TRNE NA,17 ;RELOC FIELD?
ERROR[ASCIZ/RELOC SIZE/]
POP P,RTEST
POP P,SRAD ;RESTORE RADIX
DPB N,[POINT 6,PNTR,11];DEPOSIT SIZE
TRNE B,LFPF ;( NEXT?
JRST PARLOP ;YES
TRNE B,COMF ;, NEXT?
JRST NULF ;YES
BLOP: PUSHJ P,MEVAL ;GET NEXT BYTE
TLNE UNDF ;UNDEF?
ERROR[ASCIZ/UNDEF BYTE/]
TRNE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC BYTE/]
TLNE ESPF ;SPC CHR?
ERROR[ASCIZ/SPC. CHR. IN BYTE FIELD/]
DBYT: IDPB N,PNTR ;DEPOSIT
HRRZ NA,PNTR ;DID WE ADVANCE...
CAIE NA,WRD ;TO NEXT WORD?
JSR GOTWRD ;YES
TRNN B,COMF ;, NEXT?
JRST NOCOM ;NO
PUSHJ P,SCAN ;GET THE ,
TRNE B,COMF ;, NEXT?
JRST NULF ;YES
TRNN B,LFPF ;( NEXT?
JRST BLOP ;NO
NULF: SETZB N,NA ;ZERO BYTE
JRST DBYT
NOCOM: TRNE B,LFPF ;(NEXT?
JRST PARLOP ;YES
MOVSI N,NONEM
MOVEM N,WRD+1
TRZ NOFXF ;RESTORE
JRST SPCFN ;LEAVE, THROUGH
GOTWRD: 0
MOVSI N,NONEM ;MARK WRD+1...
EXCH N,WRD+1 ;AND GET NEXT BYTE...
MOVEM N,NSAV ;& SAVE
PUSHJ P,BLOUT ;LIST BINARY
RETN ;RETURN THIS WORD
MOVE N,NSAV
MOVEM N,WRD ;GET SAVED BYTE
SOS PNTR ;ADJUST PNTR
JRST @GOTWRD
BERR1: ERROR[ASCIZ/NOT SIZE FIELD AFTER BYTE/]
JRST SPCFN
PNTR: 0
NSAV: 0
; POINT
^%POINT:PUSH P,SRAD ;SAVE CURRENT RADIX
PUSH P,RTEST
MOVEI N,12
PUSHJ P,RADX ;SET RADIX TO DEC.
TRO NOFXF ;NO FIXUPS THIS FIELD
PUSHJ P,MEVAL
TRNN NA,17
TLNE UNDF!ESPF ;SPC CHR. OR UNDEF?
JRST PER1 ;YES
POP P,RTEST
POP P,SRAD ;RESTORE RADIX
SETZM WRD
SETZM WRD+1
DPB N,[POINT 6,WRD,11];DEPOSIT SIZE
TRNN B,COMF ;, NEXT?
JRST PER2 ;NO
TLZ SFL ;SKIP THE ,
PPT3: TRZ ADFL!NOFXF ;FIXUPS OK NOW
PLOP: PUSHJ P,MEVAL ;GET NEXT EXPR.
TLNE ESPF ;SPC. CHR?
JRST PSPC ;YES
TLNE PAWF ;()?
JRST PAWT ;YES
TROE ADFL ;GOT AN ADDRESS ALREADY?
JRST LERR ;YES
HRRM N,WRD ;DEPOSIT ADDRS.
ORM NA,WRD+1 ;DEPOSIT RELOC
PPT: TLNE B,CRFG!RBRF ;CR OR ] OR >?
JRST PEND ;YES
TRNN B,COMF ;TERM BY ,?
JRST PLOP ;NO
TLZ SFL ;SKIP THE ,
PPT2: MOVSI NA,NONEM
ORM NA,WRD+1
TRO NOFXF
PUSH P,SRAD ;SAVE RADIX
PUSH P,RTEST
MOVEI N,12
PUSHJ P,RADX ;SET TO DEC.
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC CHR. OR UNDEF?
JRST PER3 ;YES
MOVNS N ;INVERT & ADD...
ADDI N,43 ;43
DPB N,[POINT 6,WRD,5] ;& DEPOSIT
PPT1: POP P,RTEST
POP P,SRAD
TRZ NOFXF
JRST SPCFN
PAWT: MOVSS N ;SWAP HALVES
TRNE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC INDEX FIELD/]
TLZ N,777760 ;CLEAR PART
ORM N,WRD ;OR IN
TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEF INDEX FIELD/]
JRST PPT
PSPC: TRNE N,COMF ;,?
JRST PPT2 ;YES
TRNE N,ATF ;@?
JRST PSAT ;YES
ERROR[ASCIZ/UNREC SPC CHR/]
JRST PPT
PSAT: MOVSI N,20 ;GET @ BIT
ORM N,WRD ;DEPOSIT
JRST PPT
PEND: MOVEI NA,44 ;GET 44
DPB NA,[POINT 6,WRD,5];DEPOSIT AS POSITION
MOVSI NA,NONEM ;MARK NONEMPTY
ORM NA,WRD+1
JRST SPCFN
PER1: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC SIZE/]
JRST PPT1
PER2: ERROR[ASCIZ/NO COMMA AFTER SIZE/]
JRST PPT3
PER3: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC POSITION/]
JRST PPT1
LERR: ERROR[ASCIZ/UNREC SYNTAX/]
JRST PPT
; SIXBIT
^%SIX: TLZ SFL ;SKIP CHR.
MOVEM N,TM1 ;SAVE VALUE (OF OP)
HRRM C,TM3 ;SAVE TERM CHR.
;IN CASE OF ACCIDENT, WE SAVE SOME THINGS HERE
SKIPN C,TLBLK
HRRO C,INLINE
MOVEM C,TXLIN
MOVE C,PGNM
MOVEM C,TXTPG
NOTNX,< MOVE C,[FILNM,,TXTFIL]
BLT C,TXTFIL+4
>;NOTNX
TNX,<
MOVE C,JFNTBL
MOVEM C,TXTFIL ;SAVE JFN
>;TNX
LOPS2: MOVEI N, ;CLEAR
MOVEI NA,6 ;COUNT
LOPS1: PUSHJ P,SCAN1 ;GET CHR.
TM3: CAIN C, ;TERM CHR?
JRST SFND ;YES
LSH N,6 ;NO, SHIFT
TRZN C,100 ;CONVERT...
TRZA C,40 ;TO...
TRO C,40 ;SIXBIT
OR N,C ;INSERT
SOJG NA,LOPS1 ;6 CHRS?
MOVEM N,WRD ;YES
MOVSI NA,NONEM ;PREPARE FLAGS
MOVEM NA,WRD+1 ;DEPOSIT
PUSHJ P,BLOUT ;LIST BINARY
RETN ;RETURN WRD
JRST LOPS2
SFND: SETZM TXTPG
CAIN NA,6 ;NONE IN THIS WORD?
JRST SNON ;NONE
LSH N,6 ;ADJUST
SOJG NA,.-1 ;...
MOVEM N,WRD ;DEPOSIT VALUE
MOVSI NA,NONEM ;AND...
MOVEM NA,WRD+1 ;FLAGS
JRST SPCFN ;RETURN
SNON: SETZM WRD+1
JRST SPCFN
; OPDEF
OPERR1: ERROR [ASCIZ/NO IDENTIFIER AFTER OPDEF/]
SETZM WRD+1
JRST SPCFN
OPERR2: SUB P,[1,,1]
ERROR [ASCIZ/VALUE OF OPDEF MUST BE DEFINED -- USE A MACRO/]
SETZM WRD+1
JRST SPCFN
^OPDTMP:0
^%OPDEF:SKIPA N,BLOCK ;DEFINE AT CURRENT BLOCK
^%GOPDE:MOVEI N,1 ;DEFINE AT OUTERMOST BLOCK (GOPDEF)
MOVEM N,OPDTMP ;STORE BLOCK LEVEL FOR THIS DEFINITION.
PUSHJ P,SCAN ;GET SIXBIT
TLNN IFLG ;IDENT?
JRST OPERR1 ;NO. ILLEGAL
PUSH P,L ;SAVE SIXBIT
OPDF1A: PUSHJ P,SCAN ;GET NEXT
TLNN SCFL ;SPC. CHR?
JRST OPDF1A ;NO. IGNORE IT.
TLNN N,LBRF ;[ OR <?
JRST OPDF1A ;NO
TRO NOFXF ;YES, NO FIXUPS
ACALL
TLNE AUNDF ;DEFINED?
JRST OPERR2 ;NO
TRZN TRBF ;TERMINATED BY ] OR >?
ERROR [ASCIZ/UNRECOGNIZED TERMINATION CHARACTER -- OPDEF/]
POP P,L ;GET SIXBIT
PUSHJ P,OPDINS ;INSERT OPDEF
OPDF4: SKIPE XCRFSW
CREF6 6,(PN)
PUSHJ P,LBLOUT
TRZ NOFXF
SETZM WRD+1
JRST SPCFN
;CALL OPDINS WITH L=SIXBIT, WRD,WRD+1 SETUP, AND OPDTMP SETUP TO BLOCK
^OPDINS:MOVE N,L
IDIVI N,HASH ;HASH
MOVM NA,NA
SKIPN PN,OPCDS(NA)
JRST OPDF2 ;NO PREVIOUS DEFINITION.
SRC2 L,PN,OPDFF ;CHECK FOR PREVIOUS DEFINITION
OPDF2: MOVEI NA,OPCDS-1(NA) ;SEARCH FOR PLACE TO INSERT NEW DEF.
;NA_"PREVIOUS ITEM".
OPDF2A: SKIPN T,1(NA) ;T_"NEXT"
JRST OPDF2B ;NO NEXT. INSERT AFTER (NA)
SKIPL PN,1(T) ;IS "NEXT" PERMANENT?
TLNN PN,20 ;NO. SKIP IF MADE BY OPDEF
JRST OPDF2B ;"NEXT" IS PERMANENT. INSERT AFTER (NA)
HRRZ PN,2(T) ;GET BLOCK BITS
CAMG PN,OPDTMP ;SKIP IF "NEXT" IS NESTED DEEPER THAN THIS DEF.
JRST OPDF2B ;"NEXT" IS AT SAME OR OUTER LEVEL AS THIS DEF.
MOVE NA,T
JRST OPDF2A
OPDF2B: GFST PN,FSTPNT ;INSERT DEFINITION
MOVEM L,(PN) ;DEPOSIT SIXBIT
MOVSI N,20 ;MARK THIS OPCODE WAS DEFINED BY THE USER
HRR N,1(NA) ;INSERT...
EXCH N,1(PN) ;IN LIST
HRRM PN,1(NA)
MOVEM N,FSTPNT
MOVE N,OPDTMP
MOVEM N,2(PN) ;SET BLOCK BIT
OPDF3: MOVE T,WRD
MOVE N,WRD+1
MOVEM T,3(PN) ;INVALIDATE EACH INTERMEDIATE DEFINITION.
MOVEM N,4(PN)
POPJ P,
OPDFF: SKIPL N,1(PN) ;HERE IF PREVIOUS DEFINITION EXISTS. CHECK ITS TYPE
TLNN N,20 ;SKIP IF OLD DEFINITION WAS BY OPDEF.
JRST OPDF2 ;OLD IS PERMANENT - MUST INSERT NEW
HRRZ T,2(PN) ;BLOCK NUMBER OF PREVIOUS DEFINITION.
CAMN T,OPDTMP
JRST OPDF3 ;SAME BLOCK - CLOBBER VALUE OF OLD DEF.
MOVE T,OPDTMP
CAIE T,1 ;IS THIS .GOPDEF?
JRST OPDF2 ;NO. INSERT LOCAL DEFINITION.
MOVE T,3(PN) ;INVALIDATE EACH INTERMEDIATE DEFINITION.
MOVE N,4(PN)
CAMN T,WRD
CAME N,WRD+1
ERROR [ASCIZ/AN OPDEF, GLOBAL TO THIS BLOCK, IS BEING CHANGED/]
HRRZ PN,PN
MOVEI N,OPCDS-1(NA) ;N_"PREVIOUS NODE ADDRESS"
OPDFF1: HRRZ T,1(N) ;T_NEXT NODE ADDRESS
CAIN T,(PN) ;SAME AS THE ONE WE'RE DELETING?
JRST OPDFF2 ;YES. DELINK THIS NODE.
MOVEI N,(T) ;MAKE THIS NODE THE "PREVIOUS NODE"
JRST OPDFF1
OPDFF2: EXCH PN,FSTPNT ;FREE LIST POINTS TO (PN). PN CONTAINS FREE POINTER
EXCH PN,1(T) ;PN_REMAINDER OF OPCODE CHAIN. FREE LIST RESTORED.
HRRM PN,1(N) ;STORE IN PREVIOUS NODE.
JRST OPDINS ;DIFFERENT BLOCK - INSERT NEW
; .LOAD AND .LIBRARY PSEUDO-OPS
;FORMAT IS .LOAD DEV:FILE[PRJ,PRG]
; OR .LOAD DEV:FILE.REL[PRJ,PRG]
;FILE EXTENSION REL IS ASSUMED, IF AN EXTENSION IS SEEN, IT MUST BE REL.
;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!!
;IF ANYBODY EVER FIXES THE LOADER, THIS SHOULD BE TENEXIZED...
LIBBLK: 0,,3 ;BLOCK TYPE 16 (OR 17), 3 DATA WORDS
0 ;RELOCATION IS ZERO
0 ;FILE NAME (SIXBIT)
0 ;PPN (WHATEVER'S RIGHT)
0 ;DEVICE (SIXBIT)
^%LBLCK:
HRLM N,LIBBLK ;STORE THE REQUEST TYPE (16 OR 17)
SETZM LIBBLK+1
PUSH P,CP ;SAVE FOR LATER. VERY IMPORTANT
PUSH P,O ;THIS MAY BE NEEDED
PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER.
MOVE N,[PUSHJ P,AFSCAN]
MOVEM N,FNREAD
ITS,< PUSH P,LIMBO >;ITS
NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE
SETZB 5,4 ;NO ASSUMED NAME OR PPN
MOVSI 3,'REL' ;ASSUME EXT>;NOTNX
;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13.
;0 IS SETUP CORRECTLY
;1,2,4,5,6,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC)
;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN
;3,7 (O,CP) ARE PRESERVED BY PUSHING AND POPPING
NOTNX,< JSR GETFIL ;GET A FILE NAME
JRST LIBER1 ;ERROR: Can't parse name
JUMPE 3,LBLCK1 ;HAPPY WITH NO EXTENSION
CAME 3,['REL ']
ERROR [ASCIZ/EXTENSION MUST BE REL/]
LBLCK1: MOVEM 1,LIBBLK+4 ;STORE DEVICE
MOVEM 4,LIBBLK+3 ;STORE PPN
MOVEM 5,LIBBLK+2 ;STORE FILE NAME
>;NOTNX
TNX,< PUSHJ P,TGETFY ;GET TENEX FILE SPEC
JRST LIBER1 ;CAN'T PARSE NAME
MOVEI 3,0
IDPB 3,1 ;NULL TO FINISH TEXT STRING
MOVSI 1,(1B12!1B17) ;NAME ONLY, SHORT FORM
HRROI 2,GTNAM ;STRING
GTJFN ;
JRST LIBER1
HRRZM 1,LIBBLK+1 ;A SAFE PLACE.
MOVE 2,1
HRROI 1,GTNAM1 ;A PLACE TO PUT DEVICE STRING
MOVSI 3,100000 ;output device field
JFNS
PUSHJ P,MSIX
MOVEM 1,LIBBLK+4 ;SAVE DEVICE
T20,< HRROI 1,GTNAM1 ;GET DIRECTORY AND DEVICE
MOVE 2,LIBBLK+1
MOVE 3,[110000,,1] ;PUNCTUATE PROPERLY
JFNS
MOVSI 1,1 ;EXACT MATCH
HRROI 2,GTNAM1
RCDIR ;CONVERT TO DIRECTORY NUMBER FOR SPECIFIC STRUCTURE
TLNE 1,(1b3) ;skip if ok.
ERROR [ASCIZ/CAN'T TRANSLATE TO DIRECTORY NUMBER/]
HRLI 3,4 ;THE "PROJECT" PART
MOVEM 3,LIBBLK+3 ;SAVE PPN
>;T20
NOT20,< HRROI 1,GTNAM1 ;STORE DIRECTORY NAME HERE
MOVE 2,LIBBLK+1 ;JFN
MOVSI 3,010000 ;OUTPUT DIR NAME ONLY
JFNS
HRROI 2,GTNAM1 ;STRING OF DIR NAME
MOVEI 1,0 ;EXACT MATCH
STDIR
JFCL
ERROR [ASCIZ/CAN'T TRANSLATE TO DIRECTORY NUMBER/]
HRLI 1,4
MOVEM 1,LIBBLK+3 ;STORE PPN
>;NOT20
HRROI 1,GTNAM1 ;STORE FILE NAME HERE
MOVE 2,LIBBLK+1 ;JFN
MOVSI 3,001000 ;FILE NAME
JFNS
PUSHJ P,MSIX
MOVEM 1,LIBBLK+2 ;file
HRROI 1,GTNAM1
MOVE 2,LIBBLK+1
MOVSI 3,000100 ;EXT
JFNS
PUSHJ P,MSIX
JUMPE 1,MSRT
CAME 1,['REL ']
ERROR [ASCIZ/EXTENSION MUST BE REL/]
MSRT: MOVE 1,LIBBLK+1
RLJFN
JUMP 16,.+1
SETZM LIBBLK+1
>;TNX
POUT 5,LIBBLK
LIBRET:
ITS,< POP P,LIMBO >
POP P,FNREAD
POP P,O
POP P,CP
TLO SFL ;LET SPCFN SEE THE CHARACTER BY WHICH WE TERMINATED
JRST SPCFN ;FINISH UP
LIBER1: ERROR [ASCIZ/CAN'T PARSE FILE NAME/]
JRST LIBRET
TNX,<
GTNAM1: BLOCK =26
MSIX: MOVEI 1,0 ;ACCUMULATE SIXBIT HERE
MOVE 2,[POINT 7,GTNAM1]
MOVE 4,[POINT 6,1]
MSIXLP: ILDB 3,2 ;GET A BYTE
JUMPE 3,CPOPJ ;RETURN ON NULL
CAIE 3,":"
CAIN 3,"."
POPJ P,
TRZ 3,40
TRNE 3,100
TRO 3,40
TLNN 4,770000 ;SKIP IF THERE'S ROOM FOR A BYTE
JRST [ERROR [ASCIZ/FILE NAME COMPONENT EXCEEDS 6 LETTERS/]
POPJ P,]
IDPB 3,4
JRST MSIXLP
>;TNX
; PURGE XPUNGE
PU6: ERROR [ASCIZ/NO SUCH SYMBOL/]
PURCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT?
JRST SPCFN ;NO. DONE
TLZ SFL ;SKIP THE COMMA
^%PURGE:
PUSHJ P,SCAN ;GET AN ID NAME
TLNN IFLG ;IDENT?
JRST PNOI ;NO. LOSE
MOVE N,L
IDIVI N,HASH
MOVM NA,NA
MOVEI PN,OPCDS-1(NA) ;DEFINED AS AN OPCODE?
PUSHJ P,PRSRCH
JRST PU2 ;NO.
PU1: PUSHJ P,PU1C ;DELINK THIS
MOVE NA,1(N)
TLNN NA,30 ;REGULAR OPCODE?
JRST PU1O ;YES. (WE CAN'T RECLAIM SPACE)
IFN CMUSW!STANSW,< TLNE NA,10 ;PREDEFINED CALLI?
JRST PU1O> ;YES. CAN'T RECLAIM SPACE EITHER
JUMPGE NA,PU1D ;JUMP IF AN OPDEF, WE CAN RECLAIM SPACE.
PU1O: SKIPE XCRFSW ;CREFFING?
CREF7 3,(N) ;YES. EMIT NORMAL OPCODE TO CREF.
JRST PURCON
PU1D: SKIPE XCRFSW
CREF6 5,(N) ;EMIT USE OF OPDEF TO CREF.
SKIPE CREFSW ;CREF IN PROGRESS? (EVEN IF XCREF)
CREF66 13,(N) ;YES. EMIT OPDEF "DEFINITION" TO CREF
PU1B: PUSH P,[PURCON] ;SET RETURN ADDRESS FROM PU1A
PU1A: MOVE PN,FSTPNT
HRRZM PN,1(N) ;STORE POINTER TO FREE LIST IN US
MOVEM N,FSTPNT ;STORE POINTER TO US IN FREE LIST.
POPJ P,
PU1C: MOVE NA,1(N) ;GET LINK OUT
HRRM NA,1(PN) ;STORE IN PREVIOUS. DELINKS N.
POPJ P,
PU3A: TLNE NA,1 ;MACRO PSEUDO OP. EMIT TO CREF?
PU3B: SKIPN XCRFSW ;YES. BUT ARE WE DOUING CREF?
JRST .+2 ;NO TO ONE OF THE ABOVE.
CREF7 5,(N) ;EMIT TO CREF
PUSHJ P,PU1C ;DELINK MACRO-ENTRY
JRST PU1B ;RETURN MACRO-ENTRY
PU2: MOVEI PN,MACRT-1(NA) ;DEFINED AS A MACRO?
PUSHJ P,PRSRCH
JRST PU4 ;NO
PU3: SKIPGE NA,3(N) ;SKIP IF REGULAR MACRO (OR IOWD)
JRST PU3A ;SPECIAL MACRO PSEUDO-OP (IF, "." OR .FNAM1)
CAIN N,%IOWD ;IS THIS IOWD?
JRST PU3B ;YES
SKIPE XCRFSW ;CREF IN PROGRESS RIGHT NOW?
CREF6 5,(N) ;CREF A MACRO REFERENCE
SKIPE CREFSW ;CREF IN PROGRESS AT ALL?
CREF66 13,(N) ;YES. EMIT MACRO "DEFINITION" TO CREF
PUSH P,B ;PURGE A MACRO. COPIED FROM MAC&REDEF
PUSH P,C
MOVE C,4(N) ;POINTER TO MACRO DEF.
PUSHJ P,PU1C ;DELINK SYMBOL ENTRY
PUSHJ P,PU1A ;GIVE BACK 5-WORD BLOCK POINTED TO BY N.
HLRZ B,(C) ;WORD COUNT OF MACRO DEF
ADDI B,(C) ;COMPUTE ADDRESS ABOVE THE MACRO DEF.
PUSHJ P,MACRET ;GIVE BACK THE MACRO DEFINITION.
POP P,C
POP P,B
JRST PURCON
PU4: MOVEI PN,SYMTAB-1(NA) ;DEFINED AS A SYMBOL?
PUSHJ P,PRSRCH
JRST PU6
MOVE NA,2(N) ;GET THE BLOCK BITS AND SYMBOL FLAGS
TDNN NA,BLOCK ;THIS BLOCK?
JRST PU6 ;NO.
TLNE NA,DEFFL!SYMFIX!INTF!EXTF!UDSF ;THESE ARE ALL REASONS NOT TO.
JRST PNOD
SKIPE XCRFSW ;CREF RIGHT NOW?
CREF6 1,(N) ;YES. THIS IS A REFERENCE TO SYMBOL
SKIPE CREFSW ;ARE WE DOING CREF? (EVEN IF XCREF)
CREF66 11,(N) ;YES. OUTPUT DEFINITION
PUSHJ P,PU1C ;DELINK SYMBOL ENTRY
JRST PU1B ;RETURN NODE TO FREE LIST
PNOD: ERROR [ASCIZ/CAN'T PURGE SYMBOL/]
JRST PURCON
PNOI: ERROR [ASCIZ/NOT IDENT/]
JRST SPCFN
;SEARCH FOR A SYMBOL TO PURGE (REMEMBER PREVIOUS LINK)
;CALL WITH: MOVEI PN,SYMTAB-1(NA)
; PUSHJ P,PRSRCH
PRSRCH: HRRZ N,1(PN) ;IS THERE A FORWARD LINK?
JUMPE N,CPOPJ ;IF NOT, FAIL.
CAMN L,(N) ;DOES IT MATCH?
JRST PRSRC1 ;YES. PN IS PREVIOUS, N IS CURRENT.
MOVEI PN,(N) ;PREVIOUS_CURRENT
JRST PRSRCH
PRSRC1: AOS (P)
POPJ P,
^%XPUNG:
SETOM XPUNGSW ;SET FLAG FOR BEND TO EXPUNGE SYMBOLS
JRST SPCFN
; SUPPRESS ASUPPRESS
SUPON1: SKIPN 3(N) ;THIS IS EXTERNAL. SKIP IF ANY FIXUPS
SKIPE 4(N)
POPJ P, ;THERE ARE FIXUPS. DON'T SUPPRESS SYMBOL.
SUPON2: TLO NA,SUPBIT ;DEFINED AND NOT REFERENCED. TURN ON SUPPRESS BIT
MOVEM NA,2(N) ;TURN ON THE SUPRRESS BIT FOR THIS SYMBOL
POPJ P,
;HERE TO SUPPRESS ONE SYMBOL POINTED TO BY N. CLOBBERS NA.
SUPONE: MOVE NA,2(N) ;GET THE VALUE FLAGS
TLNE NA,EXTF ;IS THIS DECLARED EXTERNAL?
JRST SUPON1 ;YES. HANDLE SPECIALLY.
TLNN NA,DEFFL!REFBIT!INTF ;IS THIS REF'D, INT OR UNDEF?
JRST SUPON2 ;NO. DEFINED BUT NOT REFERENCED.
POPJ P,
SU3: SKIPE XCRFSW
CREF7 3,(N) ;EMIT OPCODE (NOT OPDEF) TO CREF
JRST SUPCON
SU2: SKIPE XCRFSW
CREF6 1,(N) ;EMIT SYMBOL TO CREF
SU1: PUSHJ P,SUPONE ;SUPPRESS SYMBOL
SUPCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT?
JRST SPCFN ;NO. DONE
TLZ SFL ;SKIP THE COMMA
^%SUPPR:
PUSHJ P,SCAN ;GET AN ID NAME
TLNN IFLG ;IDENT?
JRST SNOI ;NO. LOSE
MOVE N,L
IDIVI N,HASH
MOVM NA,NA
MOVEI PN,SYMTAB-1(NA) ;ENTRY AS A SYMBOL?
PUSHJ P,PRSRCH
JRST .+2 ;NO.
JRST SU2 ;YES.
MOVEI PN,OPCDS-1(NA) ;ENTRY AS AN OPDEF?
PUSHJ P,PRSRCH
JRST SNOS ;NO. WELL, WE CAN'T DO THAT.
MOVE NA,1(N) ;GET OPCODE VALUE
TLNN NA,20 ;SKIP IF THIS IS AN OPDEF
JRST SU3 ;CAN'T DO THIS TO OPCODES
JUMPL NA,SU3 ;CAN'T DO THIS TO PSEUDO-OPS
SKIPE XCRFSW
CREF6 5,(N) ;EMIT OPDEF TO CREF
JRST SU1 ;BUT WE CAN DO IT TO OPDEFS
SNOI: ERROR [ASCIZ/NOT IDENT/]
JRST SPCFN
SNOS: ERROR [ASCIZ/NO SUCH SYMBOL/]
JRST SUPCON
^%ASUPP:
MOVSI PN,-HASH
ASUPP1: SKIPN N,SYMTAB(PN) ;GET A HASH POINTER
JRST ASUPP3 ;NONE THERE
ASUPP2: PUSHJ P,SUPONE ;SUPPRESS IT.
HRRZ N,1(N) ;LINK ON.
JUMPN N,ASUPP2 ;THRU ALL THIS CHAIN
ASUPP3: AOBJN PN,ASUPP1
MOVSI PN,-HASH ;NOW FOR THE OPDEFS
ASUPP4: SKIPN N,OPCDS(PN) ;GET A HASH POINTER
JRST ASUPP6 ;NONE THERE
ASUPP5: MOVE NA,1(N) ;MAKE SURE THIS IS AN OPDEF
TLNE NA,20 ;THIS BIT IS ON FOR OPDEF AND PSUEDO
JUMPG NA,.+2 ;JUMP IF OPCODE (AND NOT PSEUDO)
JRST ASUPP6 ;NO USER DEFINED CODES AFTER THIS POINT.
MOVE NA,2(N)
TLNN NA,REFBIT ;REFERENCED YET?
TLO NA,SUPBIT ;NO. SET SUPRESSION BIT
MOVEM NA,2(N)
HRRZ N,1(N) ;LINK ON.
JUMPN N,ASUPP5 ;THRU ALL THIS CHAIN
ASUPP6: AOBJN PN,ASUPP4
SKIPE UNIVSW
SETOM UASUPF# ;SET UNIVERSAL-ASUPPRESS
JRST SPCFN
; SHUFFLE UNIVERSAL SYMBOLS
Comment $
Up and down, up and down,
I will lead them up and down:
I am fear'd in field and town:
Goblin, lead them up and down.
A Midsummer Night's Dream, Act III Scene 2
All the universal symbols are divided into four categories:
VOU Very Old Universals
OU Old Universals
SU Scattered Universals
NU New Universals
The different categories are distinguished as follows:
VOU Left half of JOBSA points above the highest VOU symbol
OU UNIVBS = first word of OU area. UNIVFF = first word above OU area
SU are compact but they are scattered around above UNIVFF
NU have not been compacted yet.
There are two calls on the shuffler, USHUFF, where there's no io active
(except @ file, RPG file, or TMPCOR file), and USHUF1 when there is
io active that shouldn't be disturbed.
For USHUFF, OU are compacted into VOU, and USHUF1 is called.
For USHUF1, SU are moved to high core. NU are compacted to high core.
Then both are joined with OU. If called from USHUFF, the OU
become VOU by advancing JOBFF and lh of JOBSA
$
^USHUFF: ;HERE WHEN NO IO ACTIVE. REDUCE JOBFF
HLRZ 1,.JBSA ;SET JOBFF FROM LH. OF JOBSA.
HRRZM 1,.JBFF
SKIPN 2,UNIVBS ;ARE THERE ANY OU?
JRST USHUF1 ;NO.
SUBI 1,(2) ;THIS IS THE OFFSET AMOUNT (NEGATIVE)
MOVEI 3,UNIVLH-1
USHF.1: MOVEI 2,(3) ;SHUFFLE POINTER.
HRRZ 3,1(2) ;ADVANCE TO NEXT UNIV TABLE 3=CURRENT, 2=PREVIOUS
JUMPE 3,USHF.2 ;JUMP IF NO MORE
CAMGE 3,.JBFF ;SKIP IF THESE ARE NOT VOU
JRST USHF.2 ;VOU SYMBOLS DON'T GET MOVED
CAMGE 3,UNIVFF ;SKIP IF THESE ARE SU
ADDM 1,1(2) ;OU WILL BE MOVED. ADJUST PREVIOUS POINTER.
JRST USHF.1 ;LOOP. UNTIL WE FIND VOU.
;BLT OU TO VOU ADDRESSES
USHF.2: HRLZ 3,UNIVBS ;GET SOURCE
HRR 3,.JBFF ;DESTINATION
MOVE 4,UNIVFF ;LAST WORD OF SOURCE, +1
SUB 4,UNIVBS ;-FIRST WORD OF SOURCE, =LENGTH
ADD 4,.JBFF ;+DESTINATION = LAST WORD OF DESTINATION,+1
BLT 3,-1(4)
HRRZM 4,.JBFF
HRLM 4,.JBSA
SETZM UNIVBS ;NO OU SYMBOLS ANY MORE.
SETZM UNIVFF ;JOBFF=LH(JOBSA) SET TO FIRST FREE SPACE FOR NU.
^USHUF1: ;HERE AFTER PRGEND, DON'T CONFLICT WITH BUFFERS
MOVE 16,MTBPNT ;HERE'S WHERE WE MOVE SU TO GET THEM TO SAFETY.
MOVEM 16,SUNBAS# ;BASE OF SU SYMBOLS
MOVEI 3,UNIVLH-1
USHX.1: MOVEI 2,(3)
HRRZ 3,1(2) ;ADVANCE TO NEXT GROUP. 3=CURRENT, 2= PREVIOUS
JUMPE 3,USHX.4 ;JUMP IF NO MORE
CAMGE 3,.JBFF ;SKIP IF THESE ARE NOT VOU AND NOT OU
JRST USHX.4 ;THESE ARE VOU OR OU, NO MORE SU.
MOVE 16,MTBPNT ;DESTINATION OF BLT
HRRM 16,1(2) ;FIX THE BACK POINTER TO SHOW WHERE IT'S BEING PUT
HRLI 16,(3) ;SOURCE,,DESTINATION
USHX.2: HLRZ 4,1(3) ;GET THE LENGTH OF THIS GROUP
ADDI 4,(16) ;LAST WORD OF DESTINATION+1
CAMG 4,.JBREL ;MAKE SURE IT'S THERE
JRST USHX.3 ;IS OK.
PUSHJ P,COEXP
JRST USHX.2
USHX.3: MOVEI 3,(16) ;ADJUST CURRENT POINTER TO NEW LOC
BLT 16,-1(4) ;MOVE CRUD
MOVEM 4,MTBPNT ;UPDATE FS. POINTER
JRST USHX.1 ;LOOP THRU ALL SU SYMBOLS
USHX.4: SKIPN UNIVSW ;WAS THERE A UNIVERSAL FILE LAST?
JRST USHY ;NO. NOTHING TO DO.
SETZM UNIVSW ;CLEAR IT TO AVOID A SECOND CALL
;JOBFF IS THE LOWEST ADDRESS AVAILABLE FOR UNIVERSALS.
;COPY ALL THE UNVERSALS TO THE TOP OF CORE.
;RELOCATE NU SYMBOLS TO ADDRESS CONTAINED IN JOBFF.
;IF JOBFF=LH(JOBSA) THEN ADVANCE AND SET JOBFF AND JOBSA.
;IF JOBFF .NE. LH(JOBSA) STORE JOBFF IN UNIVBS, ADVANCE JOBFF AND STORE IN UNIVFF
;BNAM IS THE BLOCK NAME FOR THE UNIVERSALS.
;U.SYM, U.OPC, U.MAC ARE PARAMETERS
HRRZ 16,MTBPNT ;POINTER TO MACRO FREE SPACE.
MOVEI 14,(16) ;ADDRESS OF THE UNIV BLOCK
MOVNI 15,(16) ;OFFSET (NEGATIVE) TO LOCATE AT "ZERO"
LEG SETZM 1(14)
MOVE 1,BNAM ;BLOCK NAME FOR THE UNIV SYMBOLS
MOVEM 1,(14)
ADDI 16,5 ;ADVANCE FREE POINTER
MOVEI 12,0
MOVEI 11,U.SYM-1
PUSHJ P,USHUF2
LEG MOVEM 12,2(14) ;STORE SYM POINTER.
MOVEI 12,0
MOVEI 11,U.OPC-1
PUSHJ P,USHUF2
LEG MOVEM 12,3(14) ;STORE OPC POINTER.
MOVEI 12,0
MOVEI 11,U.MAC-1
PUSHJ P,USHUF3
LEG MOVEM 12,4(14) ;STORE MAC POINTER
;14 = FIRST ADDRESS. 16=LAST ADDRESS+1.
MOVEM 16,MTBPNT ;STORE FIRST FREE ADDRESS
MOVEI 10,(16) ;GET LAST ADDRESS+1
SUBI 10,(14) ;-FIRST ADDRESS = NUMBER OF WORDS
HRLM 10,1(14) ;STORE WORD COUNT HERE.
;HERE WE WRITE THE .FUN FILE IF WE MUST
SKIPE FUNSUP ;SUPRESS FUN FILE?
JRST USHF1B ;YES.
;PARAMETERS FOR WRITING FUN FILE: 14 IS FIRST ADDRESS 16 IS LAST ADDRESS+1
;ONE EXTRA WORD 0(16) IS WRITTEN BECAUSE OF LOSING DISK CHANNEL AT STANFORD
NOTNX,<
MOVSI FS,'DSK'
MOVEI T,17
MOVEI O,0
OPEN 1,T
JRST [OUTSTR [ASCIZ/DSK: OPEN TO WRITE .FUN FILE LOST
/]
JRST USHF1B]
SKIPN 1,BNAM ;GET BLOCK NAME (UNIVERSAL NAME)
MOVSI 1,'FUN'
TLNE 1,770000
JRST .+3
LSH 1,6
JRST .-3
MOVSI 2,'FUN' ;LEAVE HIGH DATE ZERO FOR DEFAULT
SETZB 3,4 ;LOW DATE AND PPN DEFAULT
ENTER 1,1
JRST [OUTSTR [ASCIZ/ENTER TO WRITE .FUN FILE FAILED
/]
JRST USHF1B]
>;NOTNX
TNX,<
SKIPN 1,BNAM ;NORMAL NAME IS FROM UNIV NAME
MOVSI 1,'FUN' ;DEFAULT NAME IS FUN.FUN
TLNE 1,770000
JRST .+3
LSH 1,6
JRST .-3
MOVE 2,[POINT 7,GTNAM] ;PLACETO ASSEMBLE ASCIZ STRIN
PUSHJ P,UNXNM
MOVEI 3,"."
IDPB 3,2
MOVSI 1,'FUN'
PUSHJ P,UNXNM
MOVEI 3,0
IDPB 3,2
HRROI 2,GTNAM
MOVSI 1,400001 ;NEXT VERSION. SHORT FORM
GTJFN ;GET JFN FOR FUN FILE
JRST UNVOER ;OPEN/GETJFN ERROR
HRRZM 1,UNVJFN#
HRRZ 1,1
MOVE 2,[447400,,300000] ;DUMP MODE.
OPENF
JRST UNVOER
JRST UNVOK
UNXNM: LDB 3,[POINT 6,1,5]
ADDI 3," "
IDPB 3,2
LSH 1,6
JUMPN 1,UNXNM
POPJ P,
UNVOER: OUTSTR [ASCIZ\I/O failure when writing .FUN file.
\]
JRST USHF1B
>;TNX
UNVOK:
LEG SETZM (16) ;WE NEED THIS WORD AT STANFORD AI
MOVEI 3,(14) ;FIRST ADDRESS
SUBI 3,1(16) ;-(LAST ADDRESS+1) = -(WC+1)
HRLI 3,-1(14) ;MA-1 IN LEFT HALF
MOVS 3,3 ;IOWD IN 3
MOVEI 4,0
NOTNX,<
OUTPUT 1,3
CLOSE 1,
RELEAS 1,
>;NOTNX
TNX,<
MOVE 1,UNVJFN
MOVEI 2,3 ;POINTER TO COMMAND LIST
DUMPO ;WRITE DATA
JRST UNVOER
MOVE 1,UNVJFN
CLOSF ;CLOSE AND RELEASE JFN
JRST UNVOER
>;TNX
USHF1B: MOVE 15,UNIVLH ;GET POINTER OTHER U TABLES
HRRM 15,1(14) ;STORE POINTER HERE
HRRZM 14,UNIVLH ;STORE MAIN POINTER.
SETZM UASUPF ;NO LONGER UNIVERSAL-ASUPPRESS
USHY: MOVE 4,SUNBAS
CAML 4,MTBPNT
POPJ P, ;NOTHING TO DO
;SOURCE IS SUNBAS, DESTINATION IS JOBFF. JUST QUICK RELOCATE ALL POINTERS
SUB 4,.JBFF ;THIS IS DISTANCE MOVED (POSITIVE)
MOVN 4,4 ;OFFSET (NEGATIVE)
MOVEI 3,UNIVLH-1
USHY.1: MOVEI 2,(3)
HRRZ 3,1(2) ;ADVANCE TO NEXT GROUP. 3=CURRENT, 2= PREVIOUS
JUMPE 3,USHY.2 ;JUMP IF NO MORE
CAMGE 3,SUNBAS ;SKIP IF THESE ARE SU OR NU
JRST USHY.2 ;NO MORE SU!
ADDM 4,1(2) ;SET OFFSET IN PREVIOUS POINTER
JRST USHY.1 ;LOOP
USHY.2: MOVS 10,SUNBAS ;SOURCE
HRR 10,.JBFF ;DESTINATION
MOVE 16,MTBPNT ;GET THE LAST ADDRESS
SUB 16,SUNBAS ;CALCULATE LENGTH
ADD 16,.JBFF ;LAST ADDRESS+1 OF BLT
BLT 10,-1(16) ;DO IT.
MOVE 11,.JBFF ;GET OLD JOBFF
MOVEM 16,.JBFF ;SET NEW JOBFF
HLRZ 10,.JBSA ;GET JOBSA
CAMN 10,11 ;SAME AS OLD JOBFF?
JRST [HRLM 16,.JBSA ;YES STORE JOBSA TOO
POPJ P,] ;ALL DONE NOW.
MOVEM 16,UNIVFF ;FIRST FREE ABOVE OU'S
MOVEM 11,UNIVBS ;BASE OF OU'S
POPJ P,
;HERE TO MOVE SYMBOL,OPCODE, OR MACRO-ENTRY FROM (11) TO (16)
;UPDATES
USHUF4: MOVE 10,4(11) ;GET LAST WORD.
LEG MOVEM 10,4(16) ;STORE IN FREE SPACE
MOVE 10,3(11)
MOVEM 10,3(16)
MOVE 10,2(11)
TLZ 10,REFBIT ;CLEAR REFBIT - UNIV NOT REFERENCED YET
SKIPE UASUPF ;UNIVERSAL-ASUPPRESS?
TLO 10,SUPBIT ;YES. SET SUPPRESS BIT
MOVEM 10,2(16)
MOVE 10,0(11)
MOVEM 10,0(16)
MOVE 10,1(11) ;PRESERVE LEFT HALF IN CASE OF OPDEF
HRR 10,12
MOVEM 10,1(16) ;STORE POINTER TO PREVIOUS SYMBOL
MOVEI 12,(16) ;GET POINTER TO THIS
ADD 12,15 ;ADD OFFSET = FINAL ADDRESS AFTER BLT
ADDI 16,5
POPJ P,
;HERE FOR LIST OF OPC AND SYM
USHUF2: HRRZ 11,1(11) ;ADVANCE TO NEXT ENTRY.
JUMPE 11,CPOPJ ;JUMP IF THERE IS NO NEXT.
PUSHJ P,USHUF4
JRST USHUF2 ;ADVANCE TO NEXT ENTRY
;HERE FOR MACRO LIST
USHUF3: SKIPN 11,1(11) ;ADVANCE TO NEXT ENTRY
POPJ P,
PUSHJ P,USHUF4 ;MOVE THE MACRO-ENTRY
MOVE 10,16 ;GET FREE ADDRESS
ADD 10,15 ;ADD OFFSET TO MAKE CORRECT ADDRESS
EXCH 10,-1(16) ;EXCH WITH MACRO-BODY ADDRESS
HRRM 12,(10) ;SET BACK-POINTER ADDRESS IN THE MACRO-BODY
HLRZ 7,(10) ;GET THE SIZE OF THE MACRO-BODY
ADDI 7,(16) ;CALCULATE FINAL ADDRESS+1
MOVS 10,10 ;SOURCE ADDRESS IN LEFT
HRRI 10,(16) ;DESTINATION IN RIGHT
LEG SETZM (7) ;ADDRESS BEYOND THE BLT
BLT 10,-1(7)
MOVEI 16,(7) ;FIXUP FREE STORAGE POINTER.
JRST USHUF3 ;LOOP FOR ALL MACROS
; SEARCH
SRNOI: ERROR [ASCIZ/SEARCH - NO ID/]
JRST SPCFN
SERCN0: TRNN B,LFPF ;TERMINATED BY LEFT PARENS?
JRST SPCFN ;NO. WE'RE DONE
TLZ SFL ;CLEAR SCAN AHEAD
PUSHJ P,SCAN1 ;GET NEXT CHARACTER
TDNN B,[CRFG,,RTPF] ;RIGHT PARENS OR END OF LINE?
JRST .-2 ;NO. GO UNTIL WE GET ONE
SERCON: TRNE B,RTPF ;RIGHT PARENS?
PUSHJ P,SCAN1 ;YES. GET NEXT AFTER PARENS
TLO SFL ;SET SCAN AHEAD. CHARACTER NEEDS TO BE SEEN AGAIN
TRNN B,COMF ;TERMINATED BY COMMA?
JRST SERCN0 ;NO. CHECK FOR TERMINATED BY LEFT PARENS.
TLZ SFL ;CLEAR SCAN AHEAD
^%SEAR: PUSHJ P,SCANM ;GET AN ID NAME
TLNN IFLG
JRST SRNOI ;NO ID AFTER SEARCH
MOVEI N,UNIVLH-1 ;SEARCH FOR RIGHT NAME
SEAR1: HRRZ N,1(N)
JUMPE N,SRTRD ;LOSE IF THERE ARE NO MORE
CAME L,(N) ;MATCHES?
JRST SEAR1 ;NO. LOOP ON
;NOW, N IS THE POINTER TO THE UNIVERSAL BLOCK.
;2(N) SYMBOLS - ADD TO END OF SYMBOL TABLE
;3(N) OPCODES - INSERT IN OPCODE TABLE IN FRONT OF PREDEFINED OPCODES
;4(N) MACROS - INSERT AT THE END
SEAR1A: PUSH P,N ;SAVE FOR GOOD LUCK.
MOVEI PN,1(N) ;POINTER (POINTER TO THE SYMBOLS)-1
SEAR2: HRRZ PN,1(PN) ;ADVANCE
JUMPE PN,SEAR3 ;NO MORE SYMBOLS
ADD PN,(P) ;ADD BASE OFFSET TO PN.
GFST (N,FSTPNT) ;GET FREE STORAGE
MOVE NA,1(N) ;GET NEXT POINTER
MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST
MOVSI NA,(PN) ;SOURCE
HRR NA,N ;DESTINATION
BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK
SETZM 1(N) ;CLEAR LINK ADDRESS
;The following code was added by REG. Apparently he wanted to normalize
; the flags. However in the original form it removed the effect of
; downarrows in the unv file. I now copy their effect. If that isn't
; good enough, feel free to simply delete these lines. -- Clh
HLLO NA,2(N) ;old flags,,-1
TLNN NA,DAF ;if downarrow, that's right
HRRI NA,1 ;but if not, set for outer block only
HRRM NA,2(N) ;now put in the normalized block level
;End of section referred to above ^^
PUSH P,N ;SAVE BLOCK ADDRESS
MOVE N,(PN) ;SYMBOL NAME
IDIVI N,HASH
MOVM NA,NA ;HASH VALUE
;NA = HASH VALUE. SEEK END OF THE LIST
MOVEI N,SYMTAB-1(NA) ;PREVIOUS ADDRESS
SEAR2A: MOVEI NA,(N)
HRRZ N,1(NA) ;GET NEXT ADDRESS
JUMPN N,SEAR2A
POP P,1(NA) ;STORE NEW SYMBOL BLK ADDR AT END OF LIST.
JRST SEAR2 ;GET NEXT SYMBOL
SEAR3: MOVE N,(P) ;GET UNIV BLK ADDR FROM STACK
MOVEI PN,2(N)
SEAR3A: HRRZ PN,1(PN)
JUMPE PN,SEAR4 ;NO OPCODES LEFT. DO MACROS
ADD PN,(P)
GFST (N,FSTPNT) ;GET FREE STORAGE
MOVE NA,1(N) ;GET NEXT POINTER
MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST
MOVSI NA,(PN) ;SOURCE
HRR NA,N ;DESTINATION
BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK
HLLZS 1(N) ;CLEAR LINK ADDRESS
PUSH P,N ;SAVE BLOCK ADDRESS.
MOVE N,(PN) ;SYMBOL NAME
IDIVI N,HASH
MOVM NA,NA ;HASH VALUE
MOVEI NA,OPCDS-1(NA) ;PREVIOUS ADDRESS
SEAR3B: MOVEI N,(NA)
HRRZ NA,1(N) ;GET NEXT ADDRESS
JUMPE NA,SEAR3C ;NO NEXT ADDR. N=ADDR OF LAST BLOCK
HLRZ L,1(NA) ;GET THE CODE BITS
CAIN L,20 ;PRECISELY 20 MEANS OPDEF
JRST SEAR3B ;THIS IS AN OPDEF. ADVANCE N TO CURRENT (NA) BLOCK
SEAR3C: POP P,L ;GET ADDR OF NEW SYMBOL
HRRM NA,1(L) ;STORE LINK OUT
HRRM L,1(N) ;STORE LINK IN
JRST SEAR3A ;DO MORE.
SEAR4: MOVE N,(P) ;GET UNIV BLK ADDR FROM STACK
MOVEI PN,3(N)
SEAR4A: HRRZ PN,1(PN)
JUMPE PN,[POP P,(P) ;FIX STACK
JRST SERCON] ;NO MACROS LEFT. GET NEXT ARGUMENT
ADD PN,(P)
GFST (N,FSTPNT) ;GET FREE STORAGE
MOVE NA,1(N) ;GET NEXT POINTER
MOVEM NA,FSTPNT ;KEEP FREE LIST HONEST
MOVSI NA,(PN) ;SOURCE
HRR NA,N ;DESTINATION
BLT NA,4(N) ;COPY NAME AND DEFINITION TO NEW BLOCK
HLLZS 1(N) ;CLEAR LINK ADDRESS
MOVE NA,(P) ;GET OFFSET
ADDM NA,4(N) ;ADD TO THIS BLOCK. POINTS AT OLD DEFINITION
PUSH P,N ;SAVE BLOCK ADDRESS.
MOVE N,(PN) ;SYMBOL NAME
IDIVI N,HASH
MOVM NA,NA ;HASH VALUE
HRRZ N,MACRT1(NA) ;INSERT IN FRONT OF PERMANENT DEFINITIONS
PUSH P,N ;TARGET ADDRESS - A PERMANENT DEF.
MOVEI N,MACRT-1(NA) ;PREVIOUS ADDRESS
SEAR4B: MOVEI NA,(N)
HRRZ N,1(NA) ;GET NEXT ADDRESS
CAME N,(P) ;MATCHES THE PERMANENT DEFINITION?
JUMPN N,SEAR4B ;NO MATCH. LOOP WHILE THERE'S STILL A LIST
CAME N,(P) ;MAKE SURE WE'RE WINNING.
ERROR [ASCIZ/FAIL BUG IN SEARCH /]
SUB P,[1,,1] ;THROW AWAY ADDRESS
POP P,L ;ADDRESS OF MACRO HEADER BLOCK
HRRM N,1(L) ;MAKE THIS BLOCK POINT TO PERMANENT DEFS.
HRRM L,1(NA) ;AND INSERT THIS NEW MACRO BLK ADDR INTO LIST.
HLRZ N,@4(L) ;LENGTH OF MACRO DEFINTION
ADD N,MTBPNT ;LAST ADDRESS OF DESTINATION+1
LEG SETZM -1(N) ;MAKE SURE ADDRESS EXISTS
HRLZ NA,4(L) ;ADDRESS OF MACRO DEFINITION (SOURCE)
HRR NA,MTBPNT ;ADDRESS OF MACRO FREE STORAGE. (DESTINATION)
HRRM NA,4(L) ;STORE NEW ADDRESS OF MACRO DEFINITION.
BLT NA,-1(N)
HRRM L,@MTBPNT ;STORE BACK POINTER IN MACRO DEFINITION
MOVEM N,MTBPNT ;UPDATE FREE STG POINTER
JRST SEAR4A
; SEARCH - CONTINUED. FIND AND READ A SUITABLE FUN FILE
SRTRD: PUSH P,L ;SAVE NAME OF THIS UNIVERSAL TABLE.
TRNN B,LFPF ;TERMINATED BY LEFT PARENS?
JRST SRTRD1 ;NO. THIS MEANS WE TAKE <NAME>.FUN AS THE FILE
TLZ SFL ;ADVANCE OVER THE PARENS
;THIS USES THE SAME SCANNER AS THE COMMAND LINE SCANNER! MODIFIERS BEWARE!!
;CODE COPIED FROM .LOAD
PUSH P,CP ;THIS GETS CLOBBERED AND IT'S SLIGHTLY NECESSARY
PUSH P,O ;THIS MAY BE NEEDED
PUSH P,FNREAD ;SAVE NORMAL COMMAND LINE READER.
MOVE N,[PUSHJ P,AFSCAN]
MOVEM N,FNREAD
ITS,< PUSH P,LIMBO >
SETZM UNVGTE# ;NO ERROR YET
NOTNX,< MOVSI 1,'DSK' ;ASSUMED DEVICE
SETZB 5,4 ;NO ASSUMPTION ABOUT FILE NAME OR PPN
MOVSI 3,'FUN' ;ASSUME EXT
;GETFIL CALLS SCAN1. CLOBBERS AC'S 0-13.
;0 IS SETUP CORRECTLY
;1,2,4,5,6,13 ARE CONSIDERED SCRATCH (T,FS,N,NA,PN,TAC)
;10,11 (B,C) ARE SET CORRECTLY TO LAST CHARACTER SEEN
;3,7 (O,CP) ARE PRESERVED BY PUSHING AND POPPING
JSR GETFIL ;GET A FILE NAME
>;NOTNX
TNX,< HRROI 1,[ASCIZ/DSK/]
MOVEM 1,GTDEV ;DEFAULT DEVICE
HRROI 1,[ASCIZ/FUN/]
MOVEM 1,GTEXT ;DEFAULT EXTENSION
JSR TGETF ;READ USER'S SPEC INTO GTNAM
>;TNX
CAIA ;ERROR
TRNN B,RTPF ;TERMINATED BY RIGHT PARENS?
SETOM UNVGTE ;ERROR
TNX,< MOVEI 2,0
IDPB 2,1 ;TERMINATE NAME WITH A NULL >;TNX
MOVE PN,O ;PN _ EXTENSION
ITS,< POP P,LIMBO >
POP P,FNREAD
POP P,O
POP P,CP
SKIPE UNVGTE ;ANY ERROR?
JRST SRCER2 ;YES, COMPLAIN.
;1=T=DEVICE, 5=NA=FILE, 6=PN=EXT, 4=N=PPN
PUSHJ P,UNVOPN ;OPEN DEVICE.
JRST SRCER1 ;NOT FOUND
SRTRD0: POP P,L ;GET NAME OF UNIVERSAL TABLE.
MOVEM L,(N) ;STORE IT (NEED NOT BE SAME AS IN FILE)
MOVE PN,UNIVLH ;GET LIST HEADER
HRRM PN,1(N) ;STORE IT INTO NEW UNIV TABLE
HRRZM N,UNIVLH ;AND STORE NEW UNIV ADDRESS IN LIST HEAD
JRST SEAR1A ;WE DID IT. NOW PROCESS AS NORMAL
;HERE WHEN "SEARCH FOO" APPEARS. LOOK FOR FOO.UNV ON DSK:,SYS: UNV:
SRTRD1: MOVE NA,L ;GET THE SOUGHT NAME INTO NA
TLNE NA,770000
JRST .+3 ;JUMP WHEN LEFT ADJUSTED
LSH NA,6
JRST .-3 ;LOOP UNTIL LEFT ADJUSTED
NOTNX,< MOVSI PN,'FUN' ;SET UP EXTENSION
MOVEI N,0 ;PPN=0
>;NOTNX
TNX,< HRROI PN,[ASCIZ/FUN/]
MOVEM PN,GTEXT
MOVE 1,NA
MOVE 2,[POINT 7,GTNAM]
PUSHJ P,UNXNM ;COPY FILE NAME TO GTNAM IN ASCII
IDPB 1,2 ;TERMINATE WITH NULL
>;TNX
MOVSI FS,-SRDVTL
SRTRD2: MOVE T,SRDVTB(FS) ;GET A DEVICE NAME
TNX,< MOVEM T,GTDEV ;SAVE DEVICE NAME>;TNX
PUSHJ P,UNVOPN ;OPEN THE DEVICE
JRST SRTRD3 ;NOT THERE
JRST SRTRD0 ;WE HAVE IT.
SRTRD3: AOBJN FS,SRTRD2
ERROR [ASCIZ/NO SUCH UNIVERSAL TABLE/]
SRCERR: POP P,L ;LOSE. RESET STACK
JRST SERCON
NOTNX,< DEFINE UNVDVM(A)<SIXBIT/A/> >;NOTNX
TNX,< DEFINE UNVDVM(A)<-1,,[ASCIZ/A/]> >;TNX
SRDVTB:
FOR ZOT IN (DSK,UNV,SYS) <
UNVDVM(ZOT) >
SRDVTL__.-SRDVTB
SRCER1: ERROR [ASCIZ/BINARY UNIVERSAL FILE (OR DEVICE) COULD NOT BE FOUND/]
JRST SRCERR
SRCER2: ERROR [ASCIZ/CAN'T PARSE FILE NAME/]
JRST SRCERR
NOTNX,<
SRCTMP: BLOCK 4
;ENTER WITH 2=DEVICE, 5=FILE, 6=EXT, 4=PPN
UNVOPN: MOVEM T,SRCTMP+1
MOVEI T,17
MOVEM T,SRCTMP
SETZM SRCTMP+2
OPEN 1,SRCTMP ;TRY TO OPEN DEVICE
JRST UNVRD3
MOVEM NA,SRCTMP
HLLZM PN,SRCTMP+1
SETZM SRCTMP+2
MOVEM N,SRCTMP+3
LOOKUP 1,SRCTMP
JRST UNVRD3 ;FAIL
HLRES SRCTMP+3 ;FORM -WC IN SRCTMP+3 RPH/REG 11/25/74
UNVRD0: MOVE T,MTBPNT ;GET FREE STORAGE ADDRESS
SUB T,SRCTMP+3 ;CALCULATE NEXT FREE ADDRESS
CAMG T,.JBREL
JRST UNVRD1 ;IS OK
PUSHJ P,COEXP
JRST UNVRD0 ;LOOP UNTIL BIG ENOUGH
UNVRD1: HRL T,SRCTMP+3 ;GET -WC
HRR T,MTBPNT
SUBI T,1
MOVEM T,SRCTMP ;STORE IOWD
SETZM SRCTMP+1 ;STOP COMMAND LIST
INPUT 1,SRCTMP
STATZ 1,740000
JRST UNVRD2 ;INPUT ERROR
MOVE N,MTBPNT ;GET FREE STORAGE ADDRESS
SUB N,SRCTMP+3 ;CALCULATE NEXT FREE ADDRESS
EXCH N,MTBPNT ;ADVANCE FS. GET POINTER TO UNIV. TABLE
AOS (P)
UNVRD2: CLOSE 1,
UNVRD3: RELEAS 1,
POPJ P,
>;NOTNX
TNX,<
;DEVICE NAME, EXTENSION IN GTDEV, GTEXT. FILE STRING IN GTNAM
UNVOPN: PUSH P,FS
MOVEI 1,GTTBL ;PARAMETERS FOR LONG GTJFN
HRROI 2,GTNAM ;STRING FROM USER OR FILE NAME
MOVSI 3,100000 ;ACCESS OLD FILE
MOVEM 3,(1) ;FLAGS IN PARAM BLOCK
SETZM UNVJFN ;NO JFN YET
GTJFN ;GET A HANDLE ON FILE.
JRST UNVOPX ;NO SUCH FILE (OR DEVICE) ETC.
HRRZM 1,UNVJFN ;SAVE JFN
MOVE 2,[447400,,200000] ;READ ACCESS IN DUMP MODE
OPENF ;OPEN FILE
JRST UNVOPX ;ERROR
HRRZ 1,UNVJFN
MOVE 2,[1,,12] ;GET SIZE OF FILE IN WORDS
MOVEI 3,5
GTFDB ;SIZE OF FILE TO 4
MOVE T,MTBPNT
ADDI T,(5)
LEG SETZM (T) ;REFERENCE CORE/EXPAND CORE
MOVN 3,5
HRL 3,3 ;-WC IN LEFT HALF
HRR 3,MTBPNT
SUBI 3,1 ;MA-1 IN RIGHT.
MOVEI 4,0 ;COMMAND LIST IN 3 AND 4
HRRZ 1,UNVJFN
MOVEI 2,3 ;POINTER TO COMMAND LIST
DUMPI ;READ DUMP INPUT
JRST UNVOPX ;LOSE.
AOS -1(P) ;WIN
MOVE N,MTBPNT
ADD N,5
EXCH N,MTBPNT ;ADVANCE FS POINTER. RETURN
;POINTER TO NEW UNIV. BLOCK
UNVOPX: SETZM GTDEV ;RESTORE DEVICE NAME TO DEFAULT
HRRZ 1,UNVJFN ;IS THIS JFN STILL HERE?
JUMPE 1,UNVOPY ;NO.
CLOSF ;CLOSE AND RELEASE JFN
CAIA
SETZM UNVJFN
SKIPE 1,UNVJFN
RLJFN ;RELEAS
JFCL
SETZM UNVJFN
UNVOPY: POP P,FS
POPJ P,
>;TNX
; HERE IS A MACRO FOR TITLE, SUBTTL, UNIVERSAL
DEFINE TIT $(TITCNT,Q,EXTRA,X1)
< MOVE T,[POINT 7,TITCNT+1]
IFN X1,<
MOVEI FS,0
TLOP: PUSHJ P,SCAN1 ;GET CHARACTER
JUMPGE B,TPOL ;JUMP IF NOT NUM OR LET
LSH FS,6 ;ACCUMULATE SIXBIT
ORI FS,(B)
TLNE FS,770000 ;6 CHARACTERS YET?
JRST TPOL ;YES
IDPB C,T ;NOT YET. STUFF THE ASCII
JRST TLOP
TPOL: AOSE TITLSW
ERROR [ASCIZ /TWO TITLE STATEMENTS, OR TITLE APPEARS AFTER CODE EMITTED/]
SKIPL RPGSW
JRST TPOL1
PUSH P,C
PUSH P,T
IDPB C,T
MOVEI C,15
IDPB C,T
MOVEI C,12
IDPB C,T
MOVEI C,0
IDPB C,T
OUTSTR [ASCIZ /FAIL: /]
OUTSTR TITCNT+1
POP P,T
POP P,C
TPOL1: MOVEM FS,BNAM ;DEPOSIT BLOCK NAME
MOVEM FS,LSTLAB+3
PUSHJ P,R5CON
MOVEM FS,TPOL3 ;SAVE RADIX50 FOR NAME BLOCK OUTPUT
JRST TLOP$Q+1
>;IFN X1
TLOP$Q: PUSHJ P,SCAN1 ;GET CHR.
TLNE B,CRFG ;CR?
JRST .+3 ;YES
IDPB C,T ;DEPOSIT
JRST TLOP$Q
EXTRA
MOVEI N,
REPEAT 5,< IDPB N,T>
SUBI T,TITCNT+1 ;FORM COUNT
MOVNS T ;NEGATE
HRLM T,TITCNT ;DEPOSIT
JRST SCR
>
; TITLE, UNIVERSAL, SUBTTL, GLOBAL
^%UNIV: SETOM UNIVSW ;SET FLAG FOR THIS BEING A UNIVERSAL ASSEMBLY
SETZM UASUPF ;NOT DOING UNIVERSAL-ASUPPRESS YET
^%TITLE:
TIT(TITCNT,1,,1)
^%SUB: TIT(SUBCNT,A,<NOTNX,<MOVEI N,15
IDPB N,T
MOVEI NA,12
IDPB NA,T
IDPB N,T
IDPB NA,T>;NOTNX
TNX,< MOVEI N,11
IDPB N,T
IDPB N,T>;NTX
>,0)
^%GLOB: PUSHJ P,SCANM ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOIG ;NO
MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
SKIPN PN,SYMTAB(NA);GET POINTER
JRST GER1 ;NONE
GSR: SRC1(L,PN,FNDG,JRST GER1)
GER1: ERROR[ASCIZ/GLOBAL -- NO PREVIOUS DEFINITION/]
JRST CONTG
FNDG: MOVE N,2(PN) ;GET FLAGS
TLNE N,UDSF ;UDEFINED-DEFINED IS GOOD ENOUGH
JRST GLDEF
TLNE N,DEFFL ;DEFINED?
JRST GSR+2 ;NO, TRY AGAIN
GLDEF: OR N,BLOCK ;TURN ON BLOCK BIT
TLNN N,DAF ;DOWN ARROW?
TLO N,GLOBF ;NO, SET GLOBAL
MOVEM N,2(PN) ;RESTORE FLAGS
CONTG: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO, DONE
TLZ SFL ;SKIP THE ,
JRST %GLOB ;CONTINUE
NOIG: ERROR[ASCIZ/NOT IDENT AFTER GLOBAL/]
JRST NSPCFN
; EXTERN, INTERN, PAGE, LALL, XALL, NOSYM, NOLIT, CREF, XCREF
^%EXT: PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOIE ;NO
MOVE T,2(PN) ;GET FLAGS
TLNN T,DEFFL ;DEFINED?
JRST EER1 ;YES
TLNE T,INTF
JRST EER2
TLO T,EXTF ;TURN ON EXT FLAG
MOVEM T,2(PN) ;DEPOSIT
CONTE: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO, DONE
TLZ SFL ;SKIP THE ,
JRST %EXT
EER1: ERROR[ASCIZ/EXTERNAL -- ALREADY DEFINED/]
JRST CONTE
EER2: ERROR [ASCIZ /EXTERNAL -- ALREADY INTERNAL/]
JRST CONTE
NOIE: ERROR[ASCIZ/NOT IDENT AFTER EXTERN/]
JRST NSPCFN
^%INT: PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOII ;NO
MOVE T,2(PN)
TLNE T,EXTF
JRST IER1
TLO T,INTF
MOVEM T,2(PN)
CONTI: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO
TLZ SFL ;YES, SKIP THE ,
JRST %INT
IER1: ERROR [ASCIZ /INTERNAL -- ALREADY EXTERNAL/]
JRST CONTI
NOII: ERROR[ASCIZ/NOT IDENT AFTER INTERN/]
JRST NSPCFN
^%PAGE: MOVEI TAC,14
IDPB TAC,LSTPNT
JRST SPCFN
^%LALL: JUMPL N,LAL
SETZM NOEXP
JRST SPCFN
LAL: SETOM NOEXP
JRST SPCFN
^%NOSYM:SETZM SYMOUT
JRST SPCFN
^%NOLIT:SETOM NOLTSW
JRST SPCFN
^%ONCRF:SKIPE CREFSW
SETOM XCRFSW
JRST SPCFN
^%OFCRF:SETZM XCRFSW
JRST SPCFN
; INTEGER, ARRAY, .COMMON
^%INTEG:PUSHJ P,SCANS ;GET A SYMBOL
TLNN IFLG
JRST NOII2 ;NOT IDENT
MOVE T,2(PN)
TLON T,UDSF!VARF ;SET FLAGS
TLNN T,DEFFL
JRST NXT ;BUT IGNORE IF DEFINED
MOVEM T,2(PN)
GFST TAC,FSTPNT ;GET FREE BLOCK
MOVE T,VARLST
MOVEM TAC,VARLST
EXCH T,1(TAC)
MOVEM T,FSTPNT
MOVEM PN,(TAC)
SETZM 2(TAC) ;ONE WORD
NXT: TRNN B,COMF ;IS IT A COMMA NEXT
JRST SPCFN ;GO AWAY
TLZ SFL ;GET PAST IT
JRST %INTEG ;AND TRY FOR MORE
NOII2: ERROR [ASCIZ /NOT IDENT AFTER INTEGER/]
JRST NSPCFN
^%ARAY: SETZM ARCNT# ;NUMBER OF THINGS PUSHED INTO STACK
%ARAY1: PUSHJ P,SCANS ;GET A SYMBOL
TLNN IFLG
JRST NOAR ;NOT IDENT SO LOSE
MOVE T,2(PN) ;CHECK FLAGS
TLON T,UDSF!VARF
TLNN T,DEFFL
ERROR [ASCIZ /ARRAY NAME ALREADY DEFINED/]
MOVEM T,2(PN) ;BUT THEM BACK
GFST TAC,FSTPNT
MOVE T,VARLST
MOVEM TAC,VARLST
EXCH T,1(TAC)
MOVEM T,FSTPNT
MOVEM PN,(TAC)
PUSH P,TAC
AOS ARCNT
TLNE B,LBRF ;CHECK FOR < OR [
TRNN B,TP1F ;AND THEN MAKE SURE OF [
JRST ARR3
TLZ SFL ;STOP SCANNING AHED
TRO NOFXF
PUSHJ P,MEVAL
TRNN NA,17
TLNE UNDF!ESPF ;CHECK SPECIAL OR UNDEF
JRST ARAYER
SUBI N,1 ;STORE ONE LESS
ARRY: POP P,TAC ;GET BACK A POINTER
MOVEM N,2(TAC)
SOSLE ARCNT
JRST ARRY ;GET MORE
TLNE B,RBRF
TRNN B,TP1F
JRST ARR2
PUSHJ P,SCAN
TRNN B,COMF
JRST SPCFN
TLZ SFL
JRST %ARAY
ARR3: TRNN B,COMF
JRST ARR1
TLZ SFL
JRST %ARAY1 ;GO GET ANOTHER NAME
ARR1: ERROR [ASCIZ /NEED [ AFTER ID IN ARRAY OR COMMON/]
JRST COMAER ;GO GET STUFF OFF STACK
ARAYER: ERROR [ASCIZ /ILLEGAL EXPRESSION AFTER [/]
JRST COMAER
ARR2: ERROR [ASCIZ /NO ] AFTER EXPRESSION/]
JRST COMAER
NOAR: ERROR [ASCIZ /NEED IDENT/]
JRST COMAER
POP P,TAC
COMAER: SOSL ARCNT
JRST .-2
JRST NSPCFN
^%COMMN: ;.COMMON
SETZM ARCNT# ;NUMBER OF THINGS PUSHED INTO STACK
COMM1: PUSHJ P,SCANM ;GET A SYMBOL (ALLOW MACRO EXPANSION)
TLNN IFLG
JRST NOAR ;NOT IDENT SO LOSE
MOVE FS,L ;GET SIXBIT NAME
PUSHJ P,R5CON ;CONVERT TO RADIX50
PUSH P,FS ;SAVE RADIX50 NAME ON STACK.
AOS ARCNT ;COUNT NUMBER OF THINGS PUSHED.
TLNE B,LBRF ;CHECK FOR < OR [
TRNN B,TP1F ;AND THEN MAKE SURE OF [
JRST COMM3 ;PERHAPS A COMMA
TLZ SFL ;STOP SCANNING AHEAD
TRO NOFXF ;DON'T GENERATE FIXUPS
PUSHJ P,MEVAL ;GET EXPRESSION
TRNN NA,17
TLNE UNDF!ESPF ;CHECK SPECIAL OR UNDEF
JRST ARAYER
MOVEM N,COMMB2 ;SAVE VALUE
TLNE B,RBRF
TRNN B,TP1F
JRST ARR2 ;FAILED TO TERMINATE WITH ]
COMM2: POP P,COMMB1 ;STORE RADIX50 NAME INTO LOADER BLOCK.
POUT 4,COMMB ;SEND COMMON BLOCK TO LOADER
SOSLE ARCNT ;COUNT DOWN, POPPING STACK
JRST COMM2 ;GET MORE
PUSHJ P,SCAN ;SCAN NEXT CHARACTER
TRNN B,COMF ;COMMA?
JRST SPCFN ;NO. WE'RE DONE.
TLZ SFL ;SKIP THE COMMA
JRST %COMMN ;BACK TO THE TOP.
COMM3: TRNN B,COMF ;COMMA BETWEEN NAMES?
JRST ARR1 ;NO.
TLZ SFL ;YES. SKIP COMMA.
JRST COMM1 ;GO GET ANOTHER NAME
COMMB: 20,,2 ;BLOCK TYPE 20. 2 WORDS
0 ;ZERO RELOCATION BITS
COMMB1: 0 ;STORE COMMON NAME HERE
COMMB2: 0 ;AND BLOCK SIZE HERE
; ENTRY
BEGIN ENTRY
^^%ENTRY:
SKIPE CODEM ;WAS CODE EMITTED?
ERROR [ASCIZ /ENTRY AFTER CODE EMITTED/]
PUSH P,BC ;USE THIS REGISTER AS AOBJN POINTER
MOVE BC,[XWD -=18,ENTBLK] ;FOR STORING ENTRIES
ENTR1: PUSHJ P,SCANS ;FIND A SYMBOL
TLNN IFLG ;WAS THERE A SYMBOL THERE?
JRST NOII ;NO, GIVE ERROR
MOVSI T,INTF ;SET AS INTERNAL
ORM T,2(PN) ;INTO FLAGS
MOVE FS,(PN) ;GET THE SIXBIT FOR THIS ONE
PUSHJ P,R5CON ;CONVERT TO RADIX50
MOVEM FS,(BC) ;PUT INTO ENTRY BLOCK
AOBJP BC,EMIT ;PUT OUT BLOCK IF OUT OF ROOM
GOENT: TRNN B,COMF ;COMMA FOLLOWING?
JRST ENDENT ;ALL DONE
TLZ SFL ;SET TO IGNORE COMMA
JRST ENTR1 ;AND GET MORE
ENDENT: HLRZ TAC,BC ;GET THE CURRENT COUNT
CAIN TAC,-=18 ;SEE IF ANY HAVE BEEN PUT IN
JRST FINENT ;NO, MUST HAVE BEEN A MULTIPLE OF 18
ADDI TAC,=18 ;GET COUNT (IF YOU IGNORE LEFT HALF
HRRM TAC,ENTWHO ;PUT IN BLOCK HEADER
ADDI TAC,2
MOVNS TAC
HRLM TAC,ENTHD ;AND -COUNT INTO OUTPUT POINTER
BBOUT ENTHD ;DO THE OUTPUT
FINENT: POP P,BC ;RESTORE THIS
SETZM WRD+1 ;TELL THEM NOTHING THERE
JRST SPCFN ;FINISH UP LINE
NOII: ERROR [ASCIZ /NOT IDENT AFTER ENTRY/]
JRST FINENT ;FINISH UP
EMIT: MOVE TAC,[XWD -=20,ENTWHO] ;AMOUTN TO DUMP
MOVEM TAC, ENTHD
MOVEI TAC,=18 ;NUMBER OF WORDS IN THE BLOCK
HRRM TAC,ENTWHO ;INTO BLOCK HEADER
BBOUT ENTHD ;OUTPUT IT
MOVE BC,[XWD -=18,ENTBLK]
JRST GOENT ;AND CONTINUE
ENTHD: ENTWHO
ENTWHO: XWD 4,0
0 ;RELOCATION BITS
ENTBLK: BLOCK =18
BEND ENTRY
; LINK, LINKEND
^%ENDL: PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS
TRO NOFXF
PUSHJ P,MEVAL
MOVNS N ;USE NEGATIVE OF NUMBER
JRST LINK1 ;GO CHECK AND GET REST OF JUNK
^%LINK: PUSHJ P,BFRC ;FORCE OUT BINARY AND FIXUPS
TRO NOFXF
PUSHJ P,MEVAL
LINK1: TLNN ESPF!UNDF
TRNE NA,17 ;IF SPECIAL CHR OR UNDEF EXPR
JRST LNKERR ;GIVE ERROR MESSAGE
MOVEM N,LNKNUM ;STORE NUMBER FOR OUTPUT
TRNN B,COMF ;THERE SHOULD BE A COMMA THERE
ERROR [ASCIZ /NO COMMA AFTER LINK NUMBER/]
TLZ SFL ;SKIP THE COMMA
PUSHJ P,MEVAL ;GET THE ADDRESS
TLNE UNDF!ESPF
JRST LNKERR ;UNDEF OR SPECIAL NOT PERMITTED
DPB NA,[POINT 1,LKRLC,3] ;PUT IN RELOC BIT
HRRZM N,LNKADR ;AND ADDRESS
POUT 4,LNKBLK ;OUTPUT IT
SKIPA
LNKERR: ERROR [ASCIZ /NOT EXPRESSION AFTER LINK OR LINKEND/]
SETZM WRD+1 ;RETURN NOTHING
JRST SPCFN ;DONE
LNKBLK: XWD 12,2 ;HEADER
LKRLC: 0 ;RELOC BITS
LNKNUM: 0 ;NUMBER OF LINK
LNKADR: 0 ;ADDRESS OF LINK
; RADIX50 PRINTX PRINTC .FATAL
^%RAD5: TRO NOFXF
PUSHJ P,MEVAL ;GET NUMBER
TRNN NA,17
TLNE UNDF!ESPF ;IF UNDEF OR SPECIAL CHR
JRST RAD5ER
TRNN B,COMF
ERROR [ASCIZ /NO COMMA AFTER RADIX50/]
LSH N,-2 ;JUSTIFY
DPB N,[POINT 4,WRD,3] ;SAVE IN WORD
TLZ SFL ;IGNORE COMMA
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG
ERROR [ASCIZ /NO IDENT AFTER RADIX50/]
MOVE FS,L ;GET SIXBIT
PUSHJ P,R5CON ;AND CONVERT
IORM FS,WRD ;PUT IN
MOVSI N,NONEM ;THERE IS SOMETHING THERE
MOVEM N,WRD+1 ;WITH NO RELOC
JRST SPCFN ;AND AWAY WE GO
RAD5ER: ERROR [ASCIZ /NOT EXPRESSION AFTER RADIX50/]
SETZM WRD+1
JRST SPCFN
;TYPE THE ARGUMENT TO PRINTX WITH FILE NAME, PAGE NUMBER, ETC.
^%PRNTX:PUSHJ P,ERRHED ;TYPE FILE NAME, ETC. ON TTY
TLZ SFL ;CLEAR SCANNER AHEAD. WE'RE TAKING THAT CHR.
PRNTX1: OUTCHR C
TRZ NOFXF
PUSHJ P,SCAN1 ;GET CHR.
TLNN B,CRFG!RBRF ;CR, OR ], OR >?
JRST PRNTX1
OUTSTR TTCRLF
TLNE B,CRFG ;CR?
JRST SCR ;YES.
TLO SFL ;SET SCANNER AHEAD TO RESCAN ] OR >
PUSHJ P,SCAN ;EXIT SCAN VIA SPCRET, DOING GOOD THINGS
JRST RBARET ;RETURN FROM ASSMBL FOR ] OR >
;TYPE THE ARGUMENT TO .FATAL AND DIE.
^%FATAL:OUTSTR [ASCIZ/.FATAL /]
TLZ SFL ;MARK THAT WE'VE USED UP A CHARACTER
FATAL1: OUTCHR C
TRZ NOFXF
PUSHJ P,SCAN1 ;GET CHR.
TLNN B,CRFG!RBRF ;CR, OR ], OR >?
JRST FATAL1 ;NO. TYPE IT.
OUTSTR TTCRLF
FATAL [ASCIZ/.FATAL PSEUDO-OP ENCOUNTERED./]
;TYPE TEXT DELIMITED LIKE "ASCIZ" ON TERMINAL.
^%PRNTC:
TLZ SFL ;CLEAR SCAN AHEAD
HRRM C,PRNTC2 ;SAVE TERM CHR IN INSTRUCTION
;IN CASE OF ACCIDENT, WE SAVE WHERE WE STARTED.
SKIPN C,TLBLK ;GET SOS LINE NUMBER
HRRO C,INLINE ;NONE. USE OUR COUNT
MOVEM C,TXLIN ;SAVE AS LINE NUMBER WHERE TEXT PSEUDO-OP BEGINS
MOVE C,PGNM ;GET PAGE NUMBER
MOVEM C,TXTPG ;SAVE PAGE WHERE TEXT PSEUDO-OP BEGINS
NOTNX,< MOVE C,[FILNM,,TXTFIL]
BLT C,TXTFIL+4 ;SAVE CURRENT FILE NAME >;NOTNX
TNX,< MOVE C,JFNTBL
MOVEM C,TXTFIL ;SAVE INPUT JFN >;TNX
PRNTC1: PUSHJ P,SCAN1 ;GET CHR.
PRNTC2: CAIN C, ;TERM CHR? (ADDRESS PART CLOBBERED)
JRST PRNTC3 ;YES
OUTCHR C ;NO. TYPE IT.
JRST PRNTC1
PRNTC3: SETZM TXTPG ;CLEAR STATE OF BEING INSIDE TEXT-OP
JRST SPCFN
; ASSIGN FOR TENEX (RST 9 MARCH 70) (NOT SUPPORTED BY OLD LOADER!)
; FOR TENEX, THIS IS ASSIGN, ELSEWHERE, .ASSIGN
;SYNTAX IS: ASSIGN ID1,ID2,EXP
;EXP IS OPTIONAL (1 IS THE DEFAULT).
;THE EFFECT IS TO ASSIGN THE VALUE OF ID1 TO ID2 AND THEN TO INCREMENT THE
;VALUE OF ID1 BY EXP.
ASHED: -5,,ASWHO
ASWHO: 100,,3
0
ASBLK: BLOCK 3
ASSNE1: ERROR [ASCIZ/NO IDENT/]
JRST NSPCFN
ASSNE2: ERROR [ASCIZ/ALREADY DEFINED/]
JRST NSPCFN
ASSNE3: ERROR [ASCIZ/NEED COMMA/]
JRST NSPCFN
^%ASSIG:
PUSHJ P,BFFRC ;FORCE OUT ANY BINARY AND FIXUPS
PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IS IDENT NEXT?
JRST ASSNE1
MOVE T,2(PN) ;GET FLAGS FOR THIS IDENT
TLNN T,DEFFL ;ALREADY DEFINED?
JRST ASSNE2
TLO T,EXTF ;MAKE IT EXTERNAL
MOVEM T,2(PN)
TRNN B,COMF ;WAS IDENT TERMINATED BY COMMA?
JRST ASSNE3
MOVE FS,(PN) ;GET SYMBOL
PUSHJ P,R5CON ;CONVERT TO RADIX 50
MOVEM FS,ASBLK ;PUT IN BLOCK FOR OUTPUT
TLZ SFL ;SKIP OVER THE COMMA
PUSHJ P,SCANM ;GET SECOND IDENT
MOVE FS,L
PUSHJ P,R5CON ;CONVERT TO RADIX 50
MOVEM FS,ASBLK+1
MOVEI N,1 ;DEFAULT INCREMENT IS 1
TRNN B,COMF ;IF NO COMMA
JRST ASGN1
TLZ SFL ;SKIP THE COMMA
TRO NOFXF ;NO FIXUPS ALLOWED
PUSHJ P,MEVAL ;EVALUATE THE EXPRESSION
TRNN NA,17 ;MUST NOT BE RELOCATED
TLNE UNDF!ESPF ;OR UNDEFINED OR SPECIAL RELOCATION
JRST PER1 ;IF IT IS, OUTPUT ERROR MESSAGE
ASGN1: MOVEM N,ASBLK+2 ;STORE SIZE IN BLOCK FOR OUTPUT
BBOUT ASHED ;OUTPUT THE BLOCK
JRST SPCFN ;AND CONTINUE
; .DIRECT
DIRCO1: ERROR [ASCIZ/UNKNOWN FUNCTION NAME/]
DIRCON: TRNN B,COMF ;HERE TO CONTINUE SCAN. COMMA NEXT?
JRST SPCFN ;NO. DONE
TLZ SFL ;SKIP THE COMMA
^%DIREC:
PUSHJ P,SCANM ;GET AN ID NAME
TLNN IFLG ;IDENT?
JRST PNOI ;NO. LOSE "NOT IDENT"
MOVSI N,-DIRTLN
CAME L,DIRTBL(N)
AOBJN N,.-1
JUMPGE N,DIRCO1
XCT DIRTB2(N)
JRST DIRCON
DIRTBL: ' KA10' ;DENOTE CODE TO RUN ON KA10 ONLY
' KI10' ;DENOTE CODE TO RUN ON KI10 ONLY
'.ITABM' ;
'.XTABM' ;IGNORE TABS AND BLANKS IN MACRO ARGS,
'.NOBIN' ;NO BINARY OUTPUT
'.NOUNV' ;NO BINARY UNIVERSAL OUTPUT
DIRTLN__.-DIRTBL
DIRTB2: PUSHJ P,DIRSTA ;KA10
PUSHJ P,DIRSTI ;KI10
SETZM TABMSW ;.ITABM
SETOM TABMSW ;.XTABM
PUSHJ P,DIRBSP ;.NOBIN
SETOM FUNSUP ;.NOUNV - SUPPRESS FUN FILE
DIRSTA: SKIPA N,[1] ;SET KA10
DIRSTI: MOVEI N,2 ;SET KI10
DPB N,[POINT 6,TPOL4,5] ;STORE WHERE TITLE OUTPUT WILL DO IT.
SKIPLE TITLSW ;TITLE OUTPUT ALREADY?
ERROR [ASCIZ/KA10 OR KI10 DIRECTIVE MUST PRECEDE CODE EMISSION/]
POPJ P,
DIRBSP: TRZN BDEV ;CLEAR BINARY DEVICE
POPJ P,
NOTNX,<
CLOSE 3,1 ;CLOSE OUTPUT. SUPRRESS CLOSE OUTPUT
RELEAS 3,1 ;RELEASE FILE. SUPPRESS CLOSE OUTPUT
>;NOTNX
TNX,<
HRRZ 1,JFNTBL-2+3 ;JFN FOR BINARY FILE
TLO 1,400000 ;DON'T RELEASE JFN
CLOSF
JRST DIRBXX
HRRZ 1,JFNTBL-2+3
SETZM JFNTBL-2+3
DELF
DIRBXX: PUSHJ P,[ERROR [ASCIZ/(Can't delete binary file.)/]
POPJ P,]
>;TNX
POPJ P,
BEND POPS
SUBTTL MAIN: THIS HERE IS THE ASSEMBLER
MAINQ: MOVE N,PCNT+1 ;GET RELOC
MOVEM N,DPCNT+1 ;AND SET RELOC OF .
MOVE N,PCNT
MOVEM N,DPCNT
MAIN: TLZ OPFLG!MLFT
ACALL ;CALL ASSMBL
SKIPN WRD+1 ;ANYTHING ON LINE?
JRST MAINQ ;NO, NOTHING
OUTP WRD ;OUTPUT THE STUFF
AOS OPCNT ;INCREMENT
MOVE N,OPCNT
CAMGE N,BRK ;HIGH SEGMENT?
JRST MAIN.1 ;NO,LOW SEGMENT
CAML N,HICNT ;YES. IS OPCNT HICNT?
MOVEM N,HICNT ;YES. INCREMENT HIGH
JRST MAIN.2
MAIN.1: CAML N,@CURBRK ;IS OPCNT LOCNT?
MOVEM N,@CURBRK ;YES, INCREMENT LOW
MAIN.2: AOS N,PCNT ;INCREMENT
MOVEM N,DPCNT ;SET ADDRESS OF .
SKIPN N,POLPNT ;ANY POLFIXES FOR NOW?
JRST MAIN ;NO
SETZM POLPNT ;CLEAR POINTER
PUSHJ P,BFRC ;FORCE OUT BIN
MAINL: MOVEI FS,5(N) ;SET UP POINTER
MOVE NA,1(N) ;GET NEXT PNTR.
PUSHJ P,POLOUT ;PUT OUT POLFIX
SKIPN N,NA ;ANY MORE?
JRST MAIN ;NO
JRST MAINL ;YES
BEGIN UUO SUBTTL UUO HANDLER AND OUTPUT ROUTINES
^UUO: 0
PUSH P,TAC ;SAVE AN AC.
LDB TAC,[POINT 5,40,8] ;GET UUO #
MOVE TAC,UUOTB(TAC) ;GET DISPATCH ADDRESS
EXCH TAC,(P) ;RESTORE AC, PUT DISPATCH ADDRESS ON STACK
PUSHJ P,@(P) ;CALL ROUTINE
SUB P,[1,,1] ;REMOVE DISPATCH ADDR FROM STACK
JRST @UUO ;RETURN
UUOTB: ;UUO DISPATCH TABLE
NOTNX,<FOR I_0,10
<ILUUO
>>;NOTNX
TNX,<FOR I_0,6
<ILUUO
>
UOUTST
UOUTCH
>;TNX
UERR
UFAT
UFOUT
UOUTP
UPOUT
UTRAN
UBBOUT
UCREF6
UCRF66
UCREF7
FOR I_23,37
<ILUUO
>
ILUUO: OUTSTR [ASCIZ/ILLEGAL USER UUO
/]
JRST 4,CPOPJ
BEND UUO
; BINARY I/O HANDLING ROUTINES
BEGIN BIO
^BBLK: XWD 1,0
BLOCK 23
^FBLK: XWD 10,0
BLOCK 23
^UOUTP: JUMPN BC,NOINI ;NOT FIRST WORD?
MOVE TAC,OPCNT ;GET OUTPUT ADDRESS
MOVEM TAC,BBLK+2 ;STORE
MOVE TAC,OPCNT+1 ;GET RELOCATION
LSH TAC,2 ;SHIFT
MOVEM TAC,BBLK+1 ;STORE
MOVE BC,[XWD -21,BBLK+3]
NOINI: MOVE TAC,@40 ;GET WORD
MOVEM TAC,(BC) ;STORE
AOS 40
MOVE TAC,@40 ;GET RELOC
DPB TAC,[POINT 1,TAC,34]
LDB TAC,[POINT 2,TAC,34]
OR TAC,BBLK+1 ;OR IN
AOBJP BC,FULL ;FULL?
LSH TAC,2 ;NO
MOVEM TAC,BBLK+1 ;STORE
POPJ P,
FULL: MOVEM TAC,BBLK+1 ;STORE RELOCATION
MOVEI TAC,22
HRRM TAC,BBLK ;SET COUNT
MOVE BC,[XWD -24,BBLK] ;OUTPUT COUNT
PUSHJ P,GBOUT ;OUTPUT THE BLOCK
MOVEI BC,
POPJ P,
;UBBOUT, GBOUT
UBBSV: 0
^UBBOUT:MOVEM BC,UBBSV
MOVE BC,40
MOVE BC,(BC)
PUSHJ P,GBOUT
MOVE BC,UBBSV
POPJ P,
^GBOUT: HLRZ TAC,(BC) ;GET BLOCK TYPE
CAIE TAC,4 ;IGNORE IF ENTRY
SETOM CODEM ;FLAG THAT CODE WAS PUT OUT
CAIN TAC,2 ;ALSO CHECK SYMBOLS
SETOM SYMEM
TRNN BDEV ;BIN DEVICE?
POPJ P, ;NO
SKIPG TITLSW ;TITLE (NAME) OUTPUT YET?
SKIPN CODEM ;NO. IS THIS AN ENTRY BLOCK?
JRST GBOUT0 ;TITLE (NAME) IS OUT OR THIS IS AN ENTRY BLOCK.
SKIPL TITLSW ;TITLE SET BY USER YET?
JRST GBOUTT ;YES. DO TITLE NOW.
SKIPN SYMEM ;IS THIS A SYMBOL GOING OUT.
JRST GBOUT0 ;NO. WELL, WE CAN WAIT LONGER TO INVENT NAME BLOCK
GBOUTT: PUSH P,BC
MOVE BC,[-4,,TPOL2]
HRRZM BC,TITLSW ;SET WE HAVE WRITTEN TITLE.
PUSHJ P,GBOUT0 ;WRITE 4 WORDS OF NAME BLOCK.
POP P,BC ;RESTORE ACTUAL BINARY POINTER.
GBOUT0:
STINK,< PUSHJ P,STKTRN ;TRANSLATE TO STINK FORMAT
PUSHJ P,GBOUT1
POPJ P, ;STKTRN SKIPS UPON OCCASION
^^GBOUT1: >;STINK
GBOUT2: MOVE TAC,(BC)
SOSLE ODB+2
JRST GBPT
GBOUT3:
NOTNX,< OUT 3,
JRST GBPT
OUTSTR [ASCIZ /OUTPUT ERROR ON BINARY FILE. TYPE ANY CHAR TO RETRY./]
PUSH P,T
PUSHJ P,WAIT
POP P,T
OUTSTR TTCRLF
JRST GBOUT3
>;NOTNX
TNX,<
TSVAC <1,2,3>
SKIPL JFNTBL-2+3
JRST GBOU3B ;IF FILE NOT PMAPPABLE
AOS 1,ODB ;BUMP PAGE NUMBER
HRL 1,JFNTBL-2+3 ;JFN,,PAGE
MOVE 2,[XWD 400000,BINBFP] ;THIS FORK, BIN BUFF PG
HRLZI 3,140000 ;READ/WRITE
PMAP ;CREATE NEW FILE PAGE!
GBOU3A: MOVEI 1,1000
MOVEM 1,ODB+2 ;SET BYTE COUNTER
MOVE 1,[POINT 36,BINBF]
MOVEM 1,ODB+1 ;SET POINTER
TRSTAC <1,2,3>
JRST GBPT
GBOU3B: HRRZ 1,JFNTBL-2+3 ;JFN
HRROI 2,BINBF
MOVNI 3,1000
SKIPL ODB+2 ;SKIP IF FIRST BUFFER NOT YET READY
SOUT
JRST GBOU3A
>;TNX
GBPT: IDPB TAC,ODB+1
AOBJN BC,GBOUT2
POPJ P,
^BFRC: JUMPE BC,CPOPJ
^BFX: MOVEI TAC,(BC) ;ADDRESS GETS FIXED UP TO -(BBLK+2)
HRRM TAC,BBLK ;COUNT
MOVE TAC,BBLK+1 ;GET RELOC BITS
LSH TAC,-2
LSH TAC,2
AOBJN BC,.-1 ;SHIFT RELOC BITS
MOVEM TAC,BBLK+1
MOVN BC,BBLK ;GET - COUNT
HRLI BC,-2(BC) ;SUBTRACT 2 & PUT IN LEFT HALF
HRRI BC,BBLK ;SET ADRESS
PUSHJ P,GBOUT
MOVEI BC,
POPJ P,
TPOL2: 6,,2 ;BUILD NAME BLOCK HERE.
0
^^TPOL3:0 ;THIS IS WHERE WE PUT THE RADIX50 PROGRAM NAME.
^^TPOL4:12,,0 ;PROCESSOR TYPE 12 = FAIL.
^UFOUT: MOVE TAC,@40 ;GET WORD
MOVEM TAC,(FC) ;DEPOSIT
AOS 40
MOVE TAC,@40 ;GET RELOC
ANDI TAC,3
OR TAC,FBLK+1 ;OR IN
AOBJP FC,FFUL ;FULL?
LSH TAC,2 ;NO, SHIFT
MOVEM TAC,FBLK+1 ;STORE
POPJ P,
FFUL: MOVEM TAC,FBLK+1 ;STORE RELOC BITS
MOVEI TAC,22
HRRM TAC,FBLK ;SET COUNT
PUSHJ P,BFRC ;FORCE OUT BIN
MOVE BC,[-24,,FBLK]
PUSHJ P,GBOUT ;OUTPUT IT
MOVE FC,[-22,,FBLK+2] ;INIT
SETZB BC,FBLK+1
POPJ P,
;BFFRC, FFX, UPOUT
^BFFRC: PUSHJ P,BFRC ;FORCE BINARY, AND THEN...
CAMN FC,[-22,,FBLK+2] ;FORCE ANY FIXUPS
POPJ P,
^FFX: MOVEI TAC,(FC) ;ADDRESS GETS FIXED UP TO -(FBLK+2)
HRRM TAC,FBLK ;SET COUNT
MOVE TAC,FBLK+1 ;GET RELOC BITS
LSH TAC,-2
LSH TAC,2 ;SHIFT
AOBJN FC,.-1 ;LOOP
MOVEM TAC,FBLK+1
MOVN FC,FBLK ;GET -COUNT
HRLI FC,-2(FC) ;SUB 2 & PUT IN LEFT
HRRI FC,FBLK ;SET ADDRESS
EXCH FC,BC
PUSHJ P,GBOUT ;OUTPUT IT
MOVE BC,FC
MOVE FC,[-22,,FBLK+2] ;INIT
SETZM FBLK+1
POPJ P,
^UPOUT: PUSH P,BC ;SAVE
MOVE BC,40 ;GET ADDRESS
LDB TAC,[POINT 4,BC,12] ;GET COUNT
MOVNS TAC ;NEGATE
HRL BC,TAC ;PUT IN LEFT
PUSHJ P,GBOUT ;OUTPUT IT
POP P,BC ;RESTORE
POPJ P,
^BNAM: BLOCK =20 ;BLOCK NAMES
;R5CON
; COMVERTS SIXBIT IN FS TO RADIX50 & PUTS RESULT IN FS, USES N
^R5CON: MOVEM FS,R5C1
MOVE FS,[POINT 6,R5C1]
MOVEM FS,R5C1+1
ILDB FS,R5C1+1 ;GET FIRST CHR.
MOVE FS,R5TAB(FS) ;CON TO R5
ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)
ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)
ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)
ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)
ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)
POPJ P,
R5C1: BLOCK 2
R5TAB: FOR I_0,'$'-1
<0
>
46
47
FOR I_'%'+1,'.'-1
<0
>
45
FOR I_'.'+1,'0'-1
<0
>
FOR I_1,12
<I
>
FOR I_'9'+1,'A'-1
<0
>
FOR I_13,44
<I
>
FOR I_'Z'+1,77
<0
>
BEND
BEGIN LIO SUBTTL LISTING I/O STUFF
^UERR: LDB TAC,LSTPNT ;GET CURRENT CHR
PUSH P,TAC ;SAVE
MOVEI TAC,177 ;GET DELETE
DPB TAC,LSTPNT ;OUTPUT
MOVEI TAC,13 ;PRINT...
IDPB TAC,LSTPNT ;INTEGRAL SIGN
ARNT: POP P,TAC ;GET BACK THAT CHR
IDPB TAC,LSTPNT
MOVE TAC,ERPNT ;GET ERROR POINTER
PUSH TAC,40 ;SAVE ADDRESS
AOS ERCNT ;COUNT
MOVEM TAC,ERPNT
POPJ P,
^UFAT: PUSHJ P,UERR ;PUT OUT MESSAGE
PUSHJ P,LSTFRC
JRST FEND
^BLOUT: TRNE LDEV ;LIST DEVICE?
SKIPE XL2SW ;INSIDE XLIST?
POPJ P, ;NO LIST DEVICE, OR IN XLIST
MOVE TAC,PCNT+1
TLNE TAC,INCF ;IN CORE?
JRST LBLOUT ;YES
TROE BLOSW ;SET & TEST
JSR BLOT ;NO LSTFRC SINCE LAST BLOUT
BLRET: PUSH P,T ;SAVE T
PUSH P,FS ;SAVE FS
MOVS FS,OPCNT ;GET OUTPUT LOCATION
MOVE TAC,OPCNT+1 ;GET RELOC
PUSHJ P,OCON ;CONVERT TO ASCII OCTAL
MOVEM T,LBLK ;STORE IN BUFFER
MOVEM FS,LBLK+1 ;...
LBCON: MOVE FS,WRD ;GET LEFT HALF
MOVE TAC,WRD+1 ;GET RELOC...
LSH TAC,-2 ;...
PUSHJ P,OCON ;CONVERT
MOVEM T,LBLK+2
MOVEM FS,LBLK+3
MOVS FS,WRD ;GET RIGHT HALF
MOVE TAC,WRD+1 ;GET RELOC
PUSHJ P, OCON ;CONVER
MOVEM T,LBLK+4
MOVEM FS,LBLK+5
POP P,FS ;RESTORE...
POP P,T
POPJ P,
BLOT: 0
PUSHJ P,LSTCHK ;MAKE SURE LOUT IS INTACT
MOVE TAC,[-6,,LBLK]
PUSHJ P,LOUT ;OUTPUT THE BINARY OCTAL...
MOVE TAC,[-1,,LCR]
PUSHJ P,LOUT ;AND A CRLF
JRST @BLOT
^LBLOUT:TRNE LDEV ;LIST DEVICE?
SKIPE NOLTSW ;NO LITTERAL LIST?
POPJ P, ;NO
TROE BLOSW ;SET & TEST
JSR BLOT ;NO LSTFRC SINCE...
PUSH P,T ;SAVE
PUSH P,FS
MOVE T,[BLNKS,,LBLK]
BLT T,LBLK+1 ;BLANK LOCATION FIELD
JRST LBCON
BLNKS: ASCII / /
BYTE (7)40,40,11
ASCII / /
BYTE (7)40,40,11
^VBLOUT:TRNN LDEV ;LIST DEVICE?
POPJ P, ;NO
TROE BLOSW ;ANY LSTFRC SINCE?
JSR BLOT ;NO
PUSH P,T ;SAVE
PUSH P,FS
MOVS FS,OPCNT ;GET LOCATION
MOVE TAC,OPCNT+1 ;&RELOC
PUSHJ P,OCON ;CONVERT TO ASCII
MOVEM T,LBLK
MOVEM FS,LBLK+1
MOVE T,[BLNKS,,LBLK+2]
BLT T,LBLK+5 ;BLANK VALUE
POP P,FS
POP P,T
POPJ P,
^UTRAN: TRNN LDEV ;LIST DEV EXIST?
POPJ P, ;NO
TROE BLOSW ;SET & TEST
JSR BLOT ;EXTRA BINARY, DUMP IT
MOVS TAC,40 ;GET ADDRESS
HRRI TAC,LBLK ;SET UP BLT WRD
BLT TAC,LBLK+5 ;BLT
POPJ P,
LCR: BYTE (7)15,12
^OCON: HRRI FS,0 ;CONVERT OCTAL IN LH OF FS TO ASCII IN FS AND T.
MOVEI T,0
LSHC T,3 ;MOVE DIGIT IN.
LSH T,4 ;SHIFT TO MAKE ROOM FOR THE NEXT.
LSHC T,3
LSH T,4
LSHC T,3
LSH T,4
LSHC T,3
LSH T,4
LSHC T,3
LSH T,1
IOR T,[ASCII/00000/]
LSH FS,-4 ;SHIFT THE LAST DIGIT BACK.
IOR FS,[BYTE(7)60,40,11,0,0]
TRNE TAC,1 ;RELOC?
ADD FS,[BYTE(7)0,<"'"-40>]
POPJ P,
^LSTLF: SKIPGE AHED ;LINE FEED SEEN -- IF NOT FROM MACRO
SETOM INCLIN ;PREPARE TO UPDATE LINE NUM (FOR NON-SOS FILES)
^LSTFRC:PUSHJ P,LSTCHK ;CHECK FOR CLOBBERAGE
JRST FLST
LBCLOB: ASCII / ****** LISTING LINE CLOBBERED ******/
LBCLBL__.-LBCLOB
^LSTCHK:MOVNI TAC,1
CAMN TAC,LTEST ;OVERRUN?
POPJ P, ;NO
CAMN TAC,LTEST2
JRST LST2OK
MOVE TAC,SVLNUM
MOVEM TAC,TLBLK
MOVE TAC,[LBCLOB,,TLBLK+1]
BLT TAC,TLBLK+LBCLBL ;CLOBBER LISTING LINE
MOVE TAC,[440700,,TLBLK+LBCLBL+1]
MOVEM TAC,LSTPNT
LST2OK: OUTSTR [ASCIZ /Line buffer overflow -- assembler clobbered.
/]
NOTNX,< SETZB TAC,.JBAPR ;NO MORE MPV INTERRUPTS
APRENB TAC, ;ENABLE NO INTERRUPTS
>;NOTNX
TNX,< MOVEI 1,400000 ;THIS FORK
DIR ;DISABLE INTERRUPTS
>;TNX
PUSHJ P,TTYERP
MOVE TAC,[JRST LSTFRC]
MOVEM TAC,STRT+2 ;MAKE IT DIFFICULT TO RESTART
NOTNX,< JRST 4,LSTFRC >;NOTNX
TNX,< HALTF
JRST .-1 >;TNX
^ERRHED:OUTSTR FILNM ;TYPE CURRENT FILE NAME (CALLED FROM PRINTX)
OUTSTR [ASCIZ /, PAGE /]
PUSH P,NA
MOVE N,PGNM
PUSHJ P,PGOUT
SKIPE TLBLK
JRST ERRHD1 ;SOS LINE NUM EXISTS -- USE IT
OUTSTR [ASCIZ /, LINE /]
MOVE N,INLINE
ADDI N,1
PUSHJ P,PGOUT ;NO NUM -- USE OUR OWN
ERRHD1: POP P,NA
OUTSTR TTCRLF
POPJ P,
^TTYERP:PUSH P,TAC
MOVE TAC,LSTPNT
TLO TAC,700 ;SIZE MIGHT BE 0 IN MACRO
PUSH P,T
MOVEI T,15 ;MAKE SURE WE GET A CR-LF
IDPB T,TAC
MOVEI T,12
IDPB T,TAC
PUSH P,N
PUSHJ P,ERRHED ;TYPE ERROR HEADING TEXT
MOVEI N,TLBLK
SKIPN TLBLK ;ANY SOS LINE NUM?
SKIPA TAC,[350700,,1(N)] ;NO, SKIP IT
MOVSI TAC,(<440700,,(N)>) ;YES, PRINT IT
CLOP3: ILDB T,TAC ;GET CHR OF LINE
JUMPE T,CLOP5
CLOP6: CAIN T,177 ;DELETE?
JRST CLOP2 ;YES
CLOP4: OUTCHR T ;TYPE IT
CAIE T,12 ;DONE IF IT'S LF
JRST CLOP3
MOVE TAC,LSTPNT
MOVEI T,
IDPB T,TAC ;NULL OUT FORCED CRLF (MAY SCREW UNDERLINE KLUDGE)
IDPB T,TAC
POP P,N
POP P,T
TTYERX: POP P,TAC
POPJ P,
CLOP2: ILDB T,TAC
CAIN T,13 ;INTEGRAL SIGN?
HRROI T,12 ;YES, USE LINE-FEED (BUT AVOID COMPARE)
JRST CLOP4
CLOP5: TRNE TAC,-LBFSZ ;NULL - SEE IF REALLY UNDERLINE KLUDGE
JRST CLOP3 ;CAN'T BE IF OFF END
XORI N,MBLKTLBLK ;TRY OTHER BUFFER
LDB T,TAC
JUMPN T,CLOP6 ;YUP - TIME TO SWITCH BUFFERS
XORI N,MBLKTLBLK
JRST CLOP3
PGOUT: IDIVI N,12
JUMPE N,.+4
HRLM NA,(P)
PUSHJ P,PGOUT
HLRZ NA,(P)
MOVEI T,"0"(NA)
OUTCHR T
POPJ P,
; DATA AREA FOR LISTING STUFF
^TITCNT: XWD -1,.+1
0
BLOCK 40
HEDCNT: XWD -LHEAD,.+1
ASCII / FAIL /
HEAD: BLOCK 4
NOTNX,<^FILNM: BLOCK 5;> BYTE (7)11,11
ASCII / Page/
PG: ASCII / /
BLOCK 3 ;ALLOW ROOM FOR BLOCK NAME TOO
11*200*2 ;FINISH WITH A TAB
LHEAD__.-HEDCNT-1
^SUBCNT: XWD -1,.+1
NOTNX,< BYTE (7)15,12,15,12;> BYTE (7)11,11,11,11,11
BLOCK 40
PTPNT: 0
TNX,<
^FILCNT: XWD -1,FILNM ;LH GETS CLOBBERED
^FILNM1: 0
^FILNM2: 0
^FILNM: BLOCK =28 ;ROOM FOR TENEX FILE NAME AND MISC JUNK
>;TNX
;I SEE IT, I UNDERSTAND IT, BUT I DON'T BELIEVE IT. REG
;FROM A DEC SYSTEM, I'LL BELIEVE ANYTHING... TMW
NOTNX,<
MOTAB:
FOR ZOT IN (NAJ,BEF,RAM,RPA,YAM,NUJ,LUJ,GUA,PES,TCO,VON,CED)<"ZOT"
>
>;NOTNX
^SPGNM: 0
^PGNM: 0
^LNCNT: 0
^PAGSIZ:0 ;PAGE SIZE FOR LISTING
^ERPD: BLOCK ERPLEN
^ERPNT:0
^PGBF: 0 ;FOR TYPING PAGE NUMBERS IN ERROR MESSAGES--DCS 2/6/70
0
^XPNDSW:0
^SVLNUM:0
BYTE (7)11,11,11
LBFSZ__200 ;SIZE OF LINE BUFFER - MUST BE POWER OF 2 (SEE TTYERP)
^MBLK: BLOCK LBFSZ
LTEST2: -1
^LBLK: BLOCK 6
^TLBLK: BLOCK LBFSZ
^LTEST: -1
;HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED
JRST LOUT2 ;FOR SLURP HACK ETC.
LOUTTB: JRST LOUTDL ;RUBOUT
JRST LOUTLF ;LF
JFCL ;" or <==> (^W)
JRST LOUT2 ;'
JRST LOUT2 ;=
JRST LOUTSP ;SP & TAB
JRST LOUTCR ;CR
JRST LOUTFF ;FF
JRST LOUT2 ;<{
JRST LOUT2 ;>}
LOUTLF: SOSLE LNCNT
JRST LOUT3 ;JUST OUTPUT IF NO PAGE OFLO
SKIPL LNCNT ;DON'T CLOBBER CHAR IF ABOUT TO DO HEADING
MOVEI T,14 ;ELSE TURN INTO FF
LOUTFF: SKIPGE LNCNT ;IF ALREADY OFF PAGE
JRST LOUTH ;THEN DO HEADING
SKIPGE CHRCNT ;SEE IF DOING CREF STUFF
JRST LOUT3 ;AND AVOID SPECIAL TREATMENT FOR FF
MOVSI TAC,1 ;OTHERWISE USE A BIG NUMBER
MOVEM TAC,CHRCNT ;TO GET US TO LOUTH ON THE NEXT CHAR
SETOM LNCNT ;MARK US OFF PAGE
JRST LOUT3 ;AND GO OUTPUT FF
LOUTCR: HLLZS CHRCNT ;CR RESETS POS EXCEPT HEADING FLAG
JRST LOUT3
LOUTSP: CAIE T,11 ;SEE IF THIS "SPACE" IS A TAB
JRST LOUT2 ;NO
MOVEI TAC,7 ;YES - UPDATE POS TO TAB STOP
IORM TAC,CHRCNT ;(ACTUALLY 1 SHORT)
JRST LOUT2 ;AOS AT LOUT2 WILL MAKE IT RIGHT
LOUTOV: TLNE TAC,-1 ;CHECK IF THIS IS REALLY HEADING FLAG
JRST LOUTH ;YES
HRROI TAC,[ASCIZ /
/]
PUSHJ P,LOUT ;JUST OFLO - STICK IN CRLF
JRST LOUT1A ;& REPROCESS CURRENT CHAR
LOUTDL: SKIPLE LNCNT
JRST LOUT3 ;PASS RUBOUT QUIETLY IF HEADING NOT NEEDED
LOUTH: PUSHJ P,LOUTH1 ;DO HEADING STUFF
JRST LOUT1A ;REPROCESS CURRENT CHAR
LOUTH1: HRROI TAC,[BYTE (7)15] ;HEADING TIME - FIRST OUTPUT CR
PUSHJ P,LOUT
SETZM CHRCNT ;& CLEAR FLAG
MOVE TAC,PAGSIZ
MOVEM TAC,LNCNT ;RESET LINE COUNTER
MOVE TAC,TITCNT
PUSHJ P,LOUT
PUSHJ P,PTIM
MOVE TAC,HEDCNT
PUSHJ P,LOUT
MOVE TAC,SUBCNT ;SUBTTL
TNX,< PUSHJ P,LOUT
MOVE TAC,FILCNT ;FILE NAME
PUSHJ P,LOUT
HRROI TAC,[BYTE(7)15,12,15,12] >;TNX
JRST LOUT
DEFINE DEP
< ADDI N,60
ADDI NA,60
IDPB N,PTPNT
IDPB NA,PTPNT
>
PTIM: PUSH P,N
PUSH P,NA
NOTNX,<
DATE N, ;GET DATE
MOVE NA,[POINT 7,HEAD]
MOVEM NA,PTPNT
IDIVI N,=31 ;GET DAY
MOVEM N,PG+1 ;SAVE
MOVEI N,(NA)1 ;GET DAY
IDIVI N,12 ;CON TO DEC
SKIPN N ;ZERO LEADING DIGIT?
MOVNI N,20 ;YES, CON TO BLANK
DEP
MOVEI N,"-"
IDPB N,PTPNT
MOVE N,PG+1
IDIVI N,=12 ;GET MONTH & YEAR
MOVE NA,MOTAB(NA);GET MONTH NAME
IDPB NA,PTPNT ;DEPOSIT
LSH NA,-7
IDPB NA,PTPNT
LSH NA,-7
IDPB NA,PTPNT
MOVEI NA,"-"
IDPB NA,PTPNT
ADDI N,=64
IDIVI N,12
DEP
MOVEI N,40
IDPB N,PTPNT
IDPB N,PTPNT
MSTIME N, ;GET TIME
IDIVI N,=60000 ;THROW AWAY M.S & SEC
IDIVI N,=60 ;GET HRS & MINS
MOVEM NA,PG+1 ;SAVE MINS
IDIVI N,12 ;CON TO DEC
SKIPN N
MOVNI N,20
DEP
MOVE N,PG+1
MOVEI NA,":"
IDPB NA,PTPNT
IDIVI N,12
DEP
>;NOTNX
TNX,<
TSVAC <1,2,3>
HRROI 1,HEAD
SETO 2, ;USE CURRENT DATE/TIME
HRLZI 3,000200 ;PROPER FORMAT AS BEFORE
ODTIM
TRSTAC <1,2,3>
>;TNX
SETZM PG+1
SETZM PG+2
SETZM PG+3
HRRZS PG+4
MOVE N,[POINT 7,PG,13]
MOVEM N,PTPNT
MOVE N,PGNM ;GET PAGE NUM
PUSHJ P,PGCON
AOS N,SPGNM
CAIG N,1
JRST PTIM2
MOVEI NA,"-"
IDPB NA,PTPNT
PUSHJ P,PGCON
PTIM2: MOVEI N,15
IDPB N,PTPNT
MOVEI N,12
IDPB N,PTPNT
MOVE NA,[440600,,LSTLAB+3] ;TO GET BLOCK NAME
REPEAT 6,< ILDB N,NA
ADDI N,40
IDPB N,PTPNT>
POP P,NA
POP P,N
POPJ P,
PGCON: IDIVI N,12 ;CON TO DEC
JUMPE N,PGCOA ;0?
HRLM NA,(P) ;SAVE REMAINDER
PUSHJ P,PGCON
HLRZ NA,(P) ;GET REMAINDER
PGCOA: ORI NA,60
IDPB NA,PTPNT
POPJ P,
FLST: SKIPN ERCNT ;ANY ERRORS?
JRST QLST ;NO
SKIPN TTYERR ;IF ANYBODY WILL WANT MESSAGE,
JRST LSTAR ;THEN PRINT STARS
SKIPN LISTSW
JRST QLST ; DON'T EVEN CONSIDER IT
LSTAR: PUSH P,N
MOVEI N,[ASCIZ /#####/]
SKIPL ERCNT ;DON'T PRINT STARS FOR PRINTX
PUSHJ P,ERLST ;PRINT STARS
POP P,N
SKIPN TTYERR ;LIST ERRORS ON TTY?
PUSHJ P,TTYERP ;YES - DO IT
QLST: AOSN INCLIN ;IF NECESSARY,
AOS INLINE ;UPDATE LINE NUM AFTER TTYERP
TRNE LDEV ;LISTING?
JRST YESL ;YES
HRRZ TAC,LSTPNT
CAIGE TAC,TLBLK ;POINTER IN MACRO?
SKIPA TAC,[POINT 7,MBLK+1,6] ;YES
MOVE TAC,[POINT 7,TLBLK+1,6]
SKIPN XPNDSW
TLZ TAC,7700
MOVEM TAC,LSTPNT ;RESET LSTPNT
SKIPN UNDLNS ;UNDERLINING?
JRST ERSCN ;NO
SETZM MBLK
MOVE TAC,[XWD MBLK,MBLK+1]
BLT TAC,LTEST-1;CLEAR BUFFER
SETOM LTEST2
MOVE TAC,[BYTE (7) 11]
MOVEM TAC,TLBLK+1
JRST ERSCN ;PRINT ERRORS
;ROUTINE TO OUTPUT TO LISTING FILE - AOBJN PNTR IN TAC
^LOUT: PUSH P,T ;SAVE
PUSH P,FS ;SAVE
LOUT0: PUSH P,TAC
MOVE FS,(TAC)
ANDCMI FS,1 ;CLEAR UNUSED BIT 35
LOUT1: MOVEI T,0
LSHC T,7 ;MOVE CHARACTER FROM FS TO T
LOUT1A: SKIPL TAC,CTAB(T)
JRST LOUTS ;MIGHT BE SPECIAL
IFE STANSW,< ;STANFORD AI PRINTER WINS
CAIN T,30 ;AI version of underscore
MOVEI T,"." ;convert to period otherwise
>;STANSW
LOUT2: AOS TAC,CHRCNT
CAML TAC,CHRPL
JRST LOUTOV ;OVERFLEW LINE
LOUT3: SOSG LOB+2
NOTNX,< OUTPUT 4,>
TNX,< JRST LOUT3A
LOUT30: >;TNX
IDPB T,LOB+1
LOUT4: JUMPN FS,LOUT1
POP P,TAC
AOBJN TAC,LOUT0
POP P,FS
POP P,T
POPJ P,
TNX,<
LOUT3A: TSVAC <1,2,3>
SKIPL JFNTBL-2+4
JRST LOUT3C ;IF NOT PMAPPABLE FILE
AOS 1,LOB ;UPDATE PAGE NUMBER
HRL 1,JFNTBL-2+4 ;JFN,,PAGE
MOVE 2,[XWD 400000,LSTBFP]
HRLZI 3,140000 ;READ/WRITE
PMAP ;CREATE NEW PAGE
LOUT3B: MOVEI 1,1000*5
MOVEM 1,LOB+2 ;SET COUNT
MOVE 1,[POINT 7,LSTBF]
MOVEM 1,LOB+1 ;AND POINTER
TRSTAC <1,2,3>
JRST LOUT30
LOUT3C: HRRZ 1,JFNTBL-2+4
HRROI 2,LSTBF
MOVNI 3,1000*5
SKIPL LOB+2 ;SKIP IF FIRST BUFFER NOT YET READY
SOUT
JRST LOUT3B
>;TNX
LOUTS: TLNE TAC,SCRF!CRFG ;need special handling?
XCT LOUTTB(TAC) ;THIS CHAR NEEDS WORRYING
IFE STANSW,< ;stanford AI printer will do anything
LOUTSX: CAIGE T,40 ;INSTR GETS CLOBBERED FOR CREF OUTPUT!
JUMPN TAC,CTLCON ;convert ctl chars for output
>;IFE STANSW
JUMPN TAC,LOUT2 ;JUST ORDINARY SPEC CHR?
JRST LOUT4 ;FLUSH NULLS
IFE STANSW,<
CTLCON: ADDI T,100 ;convert character to alpha form
LSHC T,-7 ;put it back for next time
MOVEI T,"^"
MOVE TAC,CTAB(T)
JRST LOUT2
>;IFE STANSW
YESL: SKIPN XPNDSW ;NOT EXPANDING NOW?
POPJ P, ;YES
TRNN MACUNF ;WAS A MACRO SEEN?
JRST LARND ;NO
PUSH P,N
PUSH P,NA
MOVE N,[POINT 7,MBLK]
MOVE NA,[POINT 7,TLBLK]
LOOP1: ILDB TAC,NA ;GET CHR FROM PRIMARY BUFFER
JUMPE TAC,LNUL ;NULL?
CAIN TAC,177 ;DELETE?
JRST LDEL ;YES
CAIN TAC,11 ;TAB?
JRST LSPA ;YES
CAIN TAC,15 ;CR?
JRST LCRE ;YES
MOVEI TAC,40 ;NONE OF THE ABOVE (USE SPACE)
LSPA: IDPB TAC,N ;DEPOSIT IN SECONDARY BUFFER
JRST LOOP1
LDEL: IBP N
ILDB TAC,NA
JRST LSPA
LNUL: ILDB TAC,N ;GET OTHER CHR.
JUMPE TAC,LOOP1 ;BOTH NULL?
CAIN TAC,177 ;DELETE?
JRST LOOP1 ;YES
CAIN TAC,11 ;TAB?
JRST OTAB ;YES
CAIN TAC,15 ;CR?
JRST OCRE ;YES
CAIN TAC,40 ;SPACE?
JRST OTAB ;YES
MOVEI TAC,30 ;UNDERLINE
OTAB: DPB TAC,NA
JRST LOOP1
LCRE: IDPB TAC,N
OCRE: DPB TAC,NA
MOVEI TAC,
IDPB TAC,N
MOVEI TAC,12
IDPB TAC,NA
LARND: SKIPN CREFSW ;CREFING?
JRST NOCREF ;NO
MOVEI TAC,177 ;DEPOSIT...
IDPB TAC,CREFPT ;END...
MOVEI TAC,101 ;OF...
IDPB TAC,CREFPT ;CREF
PUSHJ P,CREFR ;DUMP THE INFO
NOCREF: TRNN MACUNF
JRST NOMAC
MOVN TAC,N
ADDI TAC,MBLK-2
HRLI TAC,MBLK-1
MOVSS TAC
PUSHJ P,LOUT
MOVN TAC,NA
SKIPA
NOMAC: MOVN TAC,LSTPNT ;FORM...
ADDI TAC,LBLK-1 ;COUNT
HRLI TAC,LBLK
TRZE BLOSW ;ANY BINARY
JRST BYES ;YES
ADDI TAC,5 ;REDUCE COUNT
PUSH P,[BYTE (7)11,11,11];TAB ACROSS
POP P,LBLK+5
HRLI TAC,LBLK+5 ;SET ADDRESS
BYES: MOVSS TAC ;SET UP CONTROL WORD FOR...
PUSHJ P,LOUT ;LOUT
SETZM MBLK
MOVE TAC,[XWD MBLK,MBLK+1]
BLT TAC,LTEST-1;CLEAR BUFFERS
SETOM LTEST2
MOVE TAC,[BYTE (7) 11]
MOVEM TAC,TLBLK+1
HRRZ TAC,LSTPNT
TRNN MACUNF
JRST .+3
POP P,NA
POP P,N
CAIL TAC,TLBLK
SKIPA TAC,[POINT 7,TLBLK+1,6]
SKIPA TAC,[POINT 7,MBLK+1,6]
TRZ MACUNF ;CLEAR FLAG
MOVEM TAC,LSTPNT ;RESET LSTPNT
SKIPE XL2SW ;START XLIST NOW?
JRST [SETZM XL2SW ;YES.
TRZ LDEV
JRST .+1]
;FALL OFF THE PAGE INTO ERSCN
ERSCN: SKIPN ERCNT ;ANY?
POPJ P, ;NONE
NOITS,< SKIPL ERCNT ;IS THIS REALLY PRINTX?
HLLOS 42 > ;NO. MARK THAT ERRORS HAVE HAPPENED
SKIPN LISTSW ;LIST DEVICE?
SKIPN TTYERR ;ERRORS ON TTY?
JRST ERS1 ;SOMEONE WANTS ERROR MEXXAGES
MOVE TAC,[XWD -ERPLEN,ERPD-1]
MOVEM TAC,ERPNT ;NO ONE WANTS THESE ERROR MESSAGES
SETZM ERCNT
POPJ P,
ERS1: PUSH P,N ;SAVE
PUSH P,NA ;SAVE NA
PUSH P,T
PUSH P,FS
MOVE FS,LSTLAB+1 ;GET BLOCK NAME
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,LABPRT ;SAVE
MOVE N,FS ;SAVE LAST CHR
MOVE FS,LSTLAB ;GET LABEL NAME
PUSHJ P,AFROM6 ;CON TO ASCII
OR N,[BYTE(7)0,40,"&",40]
ROT T,7
DPB T,[POINT 7,N,34]
MOVEM N,LABPRT+1 ;DEPOSIT SECOND WORD
ROT FS,7
DPB FS,[POINT 7,T,34]
MOVEM T,LABPRT+2 ;DEPOSIT THIRD WORD
MOVE N,PCNT
SUB N,LSTLAB+4 ;GET DEVIATION
SETZM LABPRT+3
JUMPE N,RCQ
MOVE T,[POINT 7,LABPRT+3] ;SET UP POINTER
MOVEI NA,"+"
IDPB NA,T ;DEPOSIT +
PUSHJ P,RCR ;CONVERT
MOVEI NA,0 ;NULL TO END IT
IDPB NA,T
RCQ: MOVEI N,LABPRT
SKIPL ERCNT ;SKIP IF PRINTX.
PUSHJ P,ERLST
POP P,FS
POP P,T
SKIPG ERCNT ;PRINTX?
JRST ELOPX ;YES. SKIP LOCATION STUFF
MOVE NA,ERPNT ;GET ERROR POINTER
ELOP: POP NA,N ;GET MESSAGE
PUSHJ P,ERLST ;LIST IT
SOSLE ERCNT ;ANY MORE?
JRST ELOP ;YES
MOVEM NA,ERPNT ;RESTORE
ELOPX: POP P,NA
POP P,N
SKIPE ERCNT ;IS THIS REALLY PRINTX?
JRST [SETZM ERCNT ;YES.
POPJ P,] ;SO WE DON'T STOP
SKIPN ERSTSW ;SHOULD WE STOP?
POPJ P, ; NO
IFE EDITSW,<
TNX,< TSVAC <1> >
OUTSTR [ASCIZ /REPLY [CR] TO CONTINUE, [LF] TO CONTINUE AUTOMATICALLY
_/]
>
IFN EDITSW,<
OUTSTR [ASCIZ /REPLY 'E' - EDIT, [CR] - CONTINUE, [LF] - CONTINUE AUTOMATICALLY
_/]
>
NOTNX,<
CLRBFI ;CLEAR TYPEAHEAD
INCHRW TAC ;WAIT FOR ACTI
CLRBFI ;CLEAR TTY INPUT BUFFER
>;NOTNX
TNX,<
MOVEI 1,100 ;PRIMARY INPUT
CFIBF
PBIN
MOVE TAC,1
MOVEI 1,100
CFIBF
TRSTAC <1>
>;TNX
IFN EDITSW <
CAIE TAC,"e"
CAIN TAC,"E"
JRST EDGO
>
CAIN TAC,12 ;TURN OFF ERSTSW?
SETZM ERSTSW ;YES
POPJ P,
IFN EDITSW,<
EDGO: OUTSTR TTCRLF
MOVE 14,FNAM ;GET FILENAME
HLLZ 13,FNAM+1 ;GET EXTENSION
MOVE 11,SAVPPN ;GET PPN
MOVE 16,PGNM ;GET PAGE NUMBER
SKIPN 15,TLBLK ;DOES IT HAVE LINE NUMBERS?
SKIPA 2,[SIXBIT /TECO/] ;NO, FIRST WE'LL ASSUME TECO
IFE TYMSW,<
IFE CMUSW,< SKIPA 2,[SIXBIT /SOS/] ;YES, USE SOS>
IFN CMUSW,< SKIPA 2,[SIXBIT /LINED/]>> ;CMU STILL CALLS IT LINED (SIGH)
IFN TYMSW,< SKIPA 2,[SIXBIT /EDIT10/]> ;(SIGH)
MOVE 15,INLINE ;NO LINE NUMBERS, GET COUNT INSTEAD
IFN STANSW,< SKIPE TVFILE
MOVSI 2,'E ' >
MOVEM 2,EDITOR
MOVE [1,,RUNBLK]
JSR DELRPG
IFN TYMSW,<MOVEI 17,525252 ;UNUSUAL AS FLAG TO EDIT10>
RUN
HALT .-1 ;IN CASE IT LOSES
RUNBLK: SIXBIT /SYS/
EDITOR: BLOCK 5 >;IFN EDITSW
LABPRT: BLOCK 6
RCR: IDIVI N,10
JUMPE N,.+4
HRLM NA,(P)
PUSHJ P,RCR
HLRZ NA,(P)
ORI NA,60
IDPB NA,T
POPJ P,
^ERLST: SETZM SW1
NOITS,< HLLOS 42> ;MARK THAT ERRORS HAVE HAPPENED
PUSH P,T
PUSH P,FS
PUSH P,O
ELOP2: HRROI TAC,(N)
SKIPE LISTSW ;LIST DEVICE?
PUSHJ P,LOUT ;YES
MOVEI O,5
MOVE FS,(N) ;GET FIRST WORD
ELOP1: MOVEI T,
LSHC T,7 ;GET CHR.
JUMPE T,EDON ;DONE?
SKIPN TTYERR ;NO, TTY ERR LIST?
OUTCHR T
SOJG O,ELOP1 ;MORE THIS WORD?
AOJA N,ELOP2 ;NO, GET NEXT WORD
SW1: 0
EDON: SKIPE SW1
JRST EDON1
SETOM SW1
MOVEI N,CRLF
JRST ELOP2
EDON1: POP P,O
POP P,FS
POP P,T
POPJ P,
;CREF6, CREF7, CREF66
COMMENT $
Here's what you didn't want to know about CREF:
CREF6 sends ASCII characters for a symbol's address in FAIL's core image.
CREF6 1, ;symbol reference
CREF6 1, followed by '002 in file ;symbol definition
CREF6 10, followed by CREF 0, ;combine symbol chains at BEND
CREF6 5, ;Macro reference, opdef reference
CREF6 6, ;Macro definition, opdef definition
these give a symbol name to what was formerly known only by number
CREF66 11, ;flush symbol, litlabs, globals
CREF66 13, ;flush macro, opdefs
These are for sending ascii of the symbol name.
CREF7 3, ;opcode reference
CREF7 5, ;macro pseudo-op (IFs,IOWD) ref
CREF7 15, ;BEGIN block name
CREF7 16, ;BEND block name
$
^CREFPT:0 ;BYTE POINTER INTO CREFTB
^CREFTB:BYTE (7)177,102 ;ACCUMULATE CREF DATA
BLOCK 100
;CREF6 AC,ADDR
;EMITS TO CREF: '177 AC 6 <ASCII CHARACTERS FOR THE OCTAL VALUE OF ADDR>
;IF AC=0 THEN: 6 <ASCII CHARACTERS FOR THE OCTAL VALUE OF ADDR>
^UCREF6:SKIPN LISTSW ;LISTING?
POPJ P, ;NO
LDB TAC,[POINT 4,40,12] ;NO SIZE CHECK IF 0
JUMPE TAC,OENT ;AND NO IDPB CREFPT EITHER
HRRZ TAC,CREFPT ;GET THE POINTER ADRESS
CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END
JRST NOCDM ;PLENTY OF ROOM. GO ON.
MOVEI TAC,177
IDPB TAC,CREFPT
MOVEI TAC,104 ;'177 D MEANS EAT DATA
IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP
PUSHJ P,CREFR ;AND DUMP
NOCDM: LDB TAC,[POINT 4,40,12] ;GET TYPE
IDPB TAC,CREFPT ;DEPOSIT
OENT: HRRZ TAC,40 ;GET SIXBIT
PUSH P,L ;SAVE L
MOVEI L,6 ;INIT SIZE
IDPB L,CREFPT ;DEPOSIT SIZE
PUSH P,T ;SAVE T
CLOOP1: LDB T,[POINT 3,TAC,20] ;GET CHR.
ADDI T,"0"
IDPB T,CREFPT ;DEPOSIT CHR.
LSH TAC,3 ;SHIFT
SOJG L,CLOOP1 ;DONE?
CRFRT: POP P,T ;YES, RESTORE
POP P,L
POPJ P,
;CREF7 AC,ADDR
;EMITS '177 AC N <N CHARACTERS OF ASCII FOR THE SYMBOL NAME POINTED TO BY ADDR>
^UCREF7:SKIPN LISTSW
POPJ P,
HRRZ TAC,CREFPT ;GET THE POINTER ADRESS
CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END
JRST NOCDM7 ;NO, GO ON
MOVEI TAC,177
IDPB TAC,CREFPT
MOVEI TAC,104
IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP (RUBOUT D)
PUSHJ P,CREFR ;AND DUMP
NOCDM7: LDB TAC,[POINT 4,40,12]
IDPB TAC,CREFPT
JRST UCRF67
;CREF66 AC,ADDR DOES BOTH CREF6 AC,ADDR AND CREF7 AC,ADDR
^UCRF66:SKIPN LISTSW ;LISTING?
POPJ P, ;NO
PUSHJ P,UCREF6
UCRF67: MOVE TAC,@40 ;NOW GET THE SIXBIT
PUSH P,L
MOVEI L,5
TLNE TAC,770000 ;JUSTIFY
AOJA L,LADJ
LSH TAC,6
SOJG L,.-3
MOVEI L,1
LADJ: IDPB L,CREFPT
PUSH P,T
CLOOP2: LDB T,[POINT 6,TAC,5]
ADDI T,40
IDPB T,CREFPT
LSH TAC,6
SOJG L,CLOOP2
JRST CRFRT
;FORCE CREF INFO TO LISTING.
CREFR: MOVEI TAC,0 ;PUT OUT THE CREF INFO
REPEAT 5,<IDPB TAC,CREFPT>
PUSHJ P,LSTCHK
SKIPG LNCNT
PUSHJ P,LOUTH1 ;OUTPUT HEADING IF NEEDED (BEFORE CREF JUNK)
MOVN TAC,CREFPT ;- LAST ADDRESS
ADDI TAC,CREFTB ;+ FIRST ADDRESS = -WORD COUNT
HRLI TAC,CREFTB ;ADDRESS,,-WC
MOVS TAC,TAC ;-WC,,ADDRESS FOR LOUT
PUSH P,CHRCNT
PUSH P,LNCNT
HLLZM TAC,CHRCNT ;SET COUNTS TO PREVENT
HRRZM TAC,LNCNT ;OVERFLOW DETECTION
IFE STANSW,< PUSH P,LOUTSX ;SAVE INSTRUCTION
PUSH P,[CAIA]
POP P,LOUTSX ;CLOBBER INSTR >;NOT SU AI
PUSHJ P,LOUT ;PUT OUT CREF
IFE STANSW,< POP P,LOUTSX ;RESTORE INSTR >;NOT SU Ai
POP P,LNCNT ;RESTORE COUNTS
POP P,CHRCNT
MOVE TAC,[POINT 7,CREFTB,13]
MOVEM TAC,CREFPT ;REINITIALIZE BYTE POINTER FOR LATER DEPOSIT
POPJ P,
BEND
BEGIN ENDS SUBTTL END, PRGEND, BEND, BEGIN
;SUBROUTINE FOR MOST OF END, PRGEND
PRDEC: IDIVI T,=10
HRLM FS,(P)
SKIPE T
PUSHJ P,PRDEC
HLRZ T,(P)
ADDI T,"0"
ROT T,-7
MOVEM T,LBLK
HRROI TAC,LBLK
MSGOUT: SKIPN RPGSW
OUTSTR (TAC)
TRNE LDEV
PUSHJ P,LOUT
POPJ P,
DEFINE PRDCON(X)
< PUSHJ P,PRDEC
HRROI TAC,[ASCIZ/X/]
PUSHJ P,MSGOUT
>
DEFINE TWODIG(X)
< CAIL T,=10
JRST .+3
HRROI TAC,[ASCIZ/0/]
PUSHJ P,MSGOUT
PRDCON (<X>)
>
DEFINE THRDIG(X)
< CAIL T,=100
JRST .+3
HRROI TAC,[ASCIZ/0/]
PUSHJ P,MSGOUT
TWODIG (<X>)
>
^GTCPTM:
TNX,< MOVEI 1,400000
RUNTM
MOVEM 1,CPUTM
>;TNX
NOTNX,<
NOITS,< MOVEI 1,0
RUNTIM
MOVEM 1,CPUTM
>;NOITS
>;NOTNX
POPJ P,
CPUTM: BLOCK 2
DOEND: MOVE N,OPCNT+1 ;LOCATION COUNTER FLAGS
TLNE N,INCF ;ARE WE IN AN UNTERMINATED LITERAL?
JRST [SUB P,[1,,1] ;YES. FIX STACK AND MAKE A LOSE MESSAGE
JRST PSLIT]
PUSHJ P,VAR ;OUTPUT THE VARIABLES
PUSH P,0 ;SAVE FLAGS
TRZ LDEV ;STOP LISTING: I DON'T WANT TO SEE THESE. REG
PUSHJ P,LITOUT ;PUT OUT LITERALS
POP P,N ;RESTORE FLAG REGISTER
ANDI N,LDEV ;MASK OFF ALL BUT THIS
TDO 0,N ;RESTORE LISTING IF IT WAS ON BEFORE.
HRRZ N,BLOCK
CAIE N,1 ;AT OUTER LEVEL?
ERROR [ASCIZ/NOT ENOUGH "BEND" PSEUDO-OPS./]
TRO NOFXF
SETZM EN1+1
SETZM EN1+2
PUSHJ P,MEVAL ;GET ADDRESS
TLNE ESPF ;SPECIAL CHR?
JRST SPC ;YES
TLNE UNDF ;DEFINED?
ERROR [ASCIZ/UNDEFINED ADDRESS -- END/]
MOVEM N,EN1+2 ;DEPOSIT STARTING ADDRESS
ANDI NA,1 ;FORM RELOCATION
ROT NA,-2 ;RELOCATION
MOVEM NA,EN1+1 ;AND DEPOSIT
POUT 3,EN1 ;PUT OUT THE STARTING ADDRESS NOW
JRST EZERF
SPC: TLNN N,CRFG ;CR?
ERROR [ASCIZ/UNREC SPEC CHR -- END/]
EZERF: PUSHJ P,EBEND ;OUTPUT THIS BLOCK'S SYMBOLS. SPECIAL BEND FOR UNIV.
PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS
MOVEI O,HASH-1 ;INIT COUNT
ELOOP2: SKIPN PN,SYMTAB(O) ;GET START OF CHAIN
JRST NONTE ;NONE
ELOOP1: SKIPE CREFSW
CREF66 11,(PN)
MOVE N,2(PN) ;GET FLAGS
TLNE N,EXTF ;EXTERNAL?
JRST EEXT ;YES
TLNE N,DEFFL ;DEFINED?
JRST EUND ;NO
TLNE N,INTF ;INTERNAL?
JRST EINT ;YES
;REMAINDER ARE DOUBLE UP-ARROWED.
ELOOP3: ; ^^SYMS, INTERNALS, & EXTERNALS.
MOVE N,@US.S
EXCH N,1(PN) ;STORE FREE STG POINTER IN THIS NODE
MOVEM PN,@US.S ;STORE NODE ADDRESS IN FS POINTER
SKIPE PN,N ;SHUFFLE REGISTERS
JRST ELOOP1 ;THERE ARE MORE ON THIS CHAIN
JRST NONTE ;NONE LEFT.
ECON: SKIPE PN,1(PN) ;GET NEXT
JRST ELOOP1
NONTE: SOJGE O,ELOOP2 ;NO MORE, GET NEXT CHAIN
PUSHJ P,SBFRC ;FORCE OUT SYMBOLS
SKIPN SEG
JRST NBK ;NO UPPER SEGMENT
MOVE N,HICNT ;YES GET HIGH BREAK
MOVE NA,LOCNT ;GET LOW BREAK
MOVEM NA,WRD
MOVSI T,240000 ;BOTH RELOC
JRST ENDOUT
NBK: MOVE N,LOCNT ;GET PROGRAM BREAK
MOVEM N,WRD
MOVE NA,ABSCNT ;AND ABS PROG BREAK
CAIG NA,140
MOVEI NA, ;ONLY SET IF PAST 140
MOVSI T,200000 ;ONLY FIRST IS RELOC
ENDOUT: MOVEM T,EN2+1 ;RELOCATION
MOVEM N,EN2+2 ;IF SEG THEN <HICNT> ELSE <LOWCNT>
MOVEM NA,EN2+3 ;IF SEG THEN <LOCNT> ELSE <ABSCNT>
POUT 4,EN2 ;OUTPUT IT
MOVE N,EN1+2
MOVE NA,EN1+1
ROT NA,2
MOVEM N,WRD
MOVEM NA,WRD+1
PUSHJ P,LBLOUT ;LIST STARTING ADDRESS
PUSHJ P,SCNTIL ;GET TO LF AND FORCE LISTING
SETOM XPNDSW
PUSHJ P,LSTFRC ;FORCE LISTING
SKIPG EN2+2 ;LOW OR HIGH SET?
JRST ENDOT1 ;NO.
SKIPE SEG ;SEGMENT
SKIPA TAC,[-HIMLNG,,HIMES] ;YES. USE HIGH BREAK
MOVE TAC,[-PRMLNG,,PRMES] ;ELSE PROGRAM BREAK
PUSHJ P,MSGOUT
MOVS FS,EN2+2 ;GET THE BINARY ADDRESS
MOVE TAC,EN2+1
ROT TAC,2
ANDI TAC,3
PUSHJ P,OCON
MOVEM T,LBLK
MOVEM FS,LBLK+1
MOVE TAC,[-2,,LBLK]
PUSHJ P,MSGOUT
HRROI TAC,TTCRLF
PUSHJ P,MSGOUT
PUSHJ P,LSTFRC ;NOW REALLY FORCE LISTING
ENDOT1: SKIPG EN2+3 ;ABS OR LOW SET?
JRST ENDOT2 ;NO
SKIPE SEG ;SEGMENT
SKIPA TAC,[-LOMLNG,,LOMES] ;YES. LOW BREAK
MOVE TAC,[-ABMLNG,,ABMES] ;NO. ABS BREAK
PUSHJ P,MSGOUT
MOVS FS,EN2+3 ;GET THE BINARY
MOVE TAC,EN2+1
ROT TAC,4
ANDI TAC,3
PUSHJ P,OCON
MOVEM T,LBLK
MOVEM FS,LBLK+1
MOVE TAC,[-2,,LBLK]
PUSHJ P,MSGOUT
HRROI TAC,TTCRLF
PUSHJ P,MSGOUT
PUSHJ P,LSTFRC ;FORCE WHAT WE HAVE SO FAR
ENDOT2: PUSH P,CPUTM
PUSHJ P,GTCPTM ;GET CPU TIME
POP P,T ;GET OLD CPU TIME
SUB T,CPUTM ;LESS NEW CPU = -CPU ELAPSED TIME
MOVNM T,CPUTM+1 ;STORE CPU ELAPSED TIME
MOVE TAC,[-CPTMSL,,CPTMSG]
PUSHJ P,MSGOUT
MOVE T,CPUTM+1
IDIVI T,=1000 ;MILLISECONDS INTO FS
PUSH P,FS
IDIVI T,=60
PUSH P,FS ;SECONDS
IDIVI T,=60
PUSH P,FS ;MINUTES. HOURS IN T
JUMPE T,NOHRS ;JUMP IF NO HOURS TO PRINT
PRDCON (<:>) ;PRINT HOURS:
MOVE T,(P) ;GET MINUTES
CAIL T,=10 ;NEED EXTRA DIGITS?
JRST NOHRS ;No.
HRROI TAC,[ASCIZ/0/]
PUSHJ P,MSGOUT
NOHRS: POP P,T
PRDCON (<:>) ;PRINT MINUTES:
POP P,T
TWODIG (<.>) ;SECONDS.
POP P,T
THRDIG (< >) ;MILLISECONDS
HRROI TAC,TTCRLF
PUSHJ P,MSGOUT
JRST LSTFRC
HIMES: ASCII /HIGH SEGMENT BREAK /
HIMLNG__.-HIMES
0
LOMES: ASCII /LOW SEGMENT BREAK /
LOMLNG__.-LOMES
0
PRMES: ASCII /PROGRAM BREAK /
PRMLNG__.-PRMES
0
ABMES: ASCII /ABSOLUTE BREAK /
ABMLNG__.-ABMES
0
CPTMSG: ASCII /ELAPSED CPU TIME /
CPTMSL==.-CPTMSG
0
; END HANDLE INTERNALS, EXTERNALS, UNDEFINEDS
EINT: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO R5
TLO FS,40000 ;MARK AS INTERNAL
MOVE N,2(PN)
ITS,< TLNE N,SUPBIT!ANONF >;ITS
NOITS,< TLNE N,SUPBIT >;NOITS DON'T PASS ON SUPPRESSED SYMS.
JRST ELOOP3
TLNE N,DBLF
TLO FS,SNB ;THESE CAN BE HALF-KILLED, TOO
MOVEM FS,IOU+2 ;DEPOSIT
MOVE L,3(PN) ;GET VALUE
MOVEM L,IOU+3 ;DEPOSIT
MOVE L,4(PN) ;GET RELOC
DPB L,[POINT 1,IOU+1,3] ;DEPOSIT
POUT 4,IOU ;OUTPUT IT
JRST ELOOP3 ;EMIT TO UNIV. CONTINUE SCAN FOR SYMBOLS
IOU: XWD 2,2
BLOCK 3
EUND: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,EUOUT ;DEPOSIT
OR FS,[BYTE (7)0,11,"U","N","D"]
MOVEM FS,EUOUT+1 ;DEPOSIT
SKIPE FS,3(PN) ;GET FIXUP POINTER
SKIPA TAC,4(FS) ;GET RELOC
SKIPA TAC,[0] ;NO RELOC(NO FIXUP)
MOVE FS,3(FS) ;GET FIXUP VALUE
MOVSS FS
PUSHJ P,OCON ;CON TO OCTAL ASCII
MOVEM T,EUOUT+3 ;DEPOSIT
MOVEM FS,EUOUT+4 ;...
MOVEI N,EUOUT
PUSHJ P,ERLST ;LIST
JRST ECON
EEXT: MOVEI N,1 ;IN CASE THIS IS BEING KEPT AS A UNIVERSAL, REG 9/75
IORB N,2(PN) ;SET A BLOCK BIT SO SUBSEQUENT USERS WILL SEE IT.
MOVE FS,2(PN) ;GET FLAGS.
SKIPN 3(PN) ;IS THERE A FIXUP POINTER?
TLNN FS,SUPBIT ;NO. IS THIS SUPPRESSED?
JRST EEXT1 ;FIXUP POINTER, OR NOT SUPPRESSED
SKIPN 4(PN) ;SUPPRESSED AND NO FIXUPS. ANY POLISH FIXUPS?
JRST ELOOP3 ;NO REFERENCES AND THIS IS SUPRRESSED. OMIT SYMBOL.
EEXT1: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO R5
TLO FS,600000 ;MARK AS EXT
MOVEM FS,IOU+2 ;DEPOSIT
SKIPN N,3(PN) ;GET FIXUP POINTER
JRST [SETZM IOU+1 ;ISSUE NULL REQUEST
SETZM IOU+3 ;TO ABS 0
POUT 4,IOU
JRST ECONN] ;OUTPUT IT. SCAN MORE SYMBOLS
EXCON: SKIPE NA,(N) ;GET DEVIATION
JRST POLEX ;NOT 0. NEED TO USE POLISH
MOVE TAC,2(N) ;GET FLAGS
TRNE TAC,3 ;LEFT HALF OR FULL?
JRST POLEX ;YES - USE POLISH
MOVE TAC,3(N) ;GET VALUE
MOVEM TAC,IOU+3 ;DEPOSIT
MOVE TAC,4(N) ;RELOC
DPB TAC,[POINT 1,IOU+1,3] ;DEPOSIT
POUT 4,IOU ;OUTPUT
SKIPE N,1(N) ;IS THERE MORE?
JRST EXCON ;YES. DO IT.
ECONN: SKIPN N,4(PN) ;ANY POLFIXES?
JRST ECONN1 ;NO.
ECLOP: SOSG 1(N) ;LAST SYM?
JRST LAST ;YES
MOVSS N
SKIPE N,2(N) ;GET NEXT
JRST ECLOP ;MORE
ECONN1: SETZM 3(PN) ;IN CASE OF UNIVERSALS, FLUSH OLD FIXUPS.
SETZM 4(PN)
JRST ELOOP3
; PROCESS EXTERNALS - CONTINUED
LAST: MOVEI FS,5(N) ;SET UP POINTER
PUSH P,O
PUSHJ P,REDUC ;REDUCE POLISH
POP P,O
PUSHJ P,BFRC ;FORCE OUT BIN
MOVEI FS,5(N) ;SET UP POINTER
MOVS NA,N ;GET NEXT
MOVE NA,2(NA)
PUSHJ P,POLOUT ;PUT OUT POLISH
SKIPN N,NA ;ANY MORE?
JRST ECON ;NO
JRST ECLOP ;YES
EXPOL: 11,,5
0
3,,2
0
1,,0
0
0
POLEX: MOVE NA,N
MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO RADIX50
TLO FS,40000
MOVEM FS,EXPOL+3 ;DEPOSIT
MOVE FS,(NA) ;GET DEVIATION
HRLM FS,EXPOL+5 ;DEPOSIT
HLRM FS,EXPOL+4 ;...
MOVE FS,2(NA) ;GET FLAGS
ANDI FS,3
SETCA FS, ;FORM STORE OP
HRRM FS,EXPOL+5 ;DEPOSIT
MOVE FS,3(NA) ;GET FIXUP LOC.
HRLM FS,EXPOL+6 ;DEPOSIT
MOVE FS,4(NA) ;GET RELOC
DPB FS,[POINT 1,EXPOL+1,8] ;DEP.
POUT 7,EXPOL ;OUTPUT IT
SKIPE N,1(NA) ;GET NEXT
JRST EXCON ;MORE
JRST ECONN ;NO MORE
; END AND PRGEND
^%END: PUSHJ P,DOEND
NOTNX,<
^FEND: CLOSE 1,
^FEND1: RELEAS 4,
RELEAS 2,
NOITS,< MOVE N,RELFIL+4 ;DEVICE NAME WHERE REL FILE IS GOING
DEVCHR N, ;GET DEVICE CHARACTERISTICS WORD
TRNE BDEV ;SKIP IF THERE'S NO BINARY ANYWAY
TLNN N,200000 ;DVDSK?
JRST FEND2 ;NO BINARY, OR NOT DISK. AVOID RENAME.
CLOSE 3, ;DSKSER SCREWS FILE IF RENAME BEFORE CLOSE
IFE TYMSW,<
FEND0: DATE NA, ;GET DATE
TIMER N, ;GET TIME IN JIFFIES
DATE T,
CAME T,NA
JRST FEND0 ;AVOID BEING SCREWED AT MIDNIGHT!
IDIVI N,=3600 ;MINUTES IN N.
HRRM T,RELFIL+1 ;SET DATE
LDB NA,[POINT 3,T,23] ;GET HIGH PART OF DATE
DPB NA,[POINT 3,RELFIL+1,20] ;STUFF IT
DPB N,[POINT 11,T,23] ;STORE TIME
TLO T,600 ;SET MODE TO 14
IFN STANSW,< TLO T,400000 ;SET DUMP NEVER >
MOVEM T,RELFIL+2
SETZM RELFIL+3
RENAME 3,RELFIL ;ADJUST DATE & TIME TO END OF ASSEMBLY
JFCL ; (LESS RPG LOSSAGE)>
FEND2: >;NOITS
RELEAS 3,
JRST STRT1
>;NOTNX
TNX,<
^FEND:
^FEND1: JSR CLSSRC
TRNE LDEV
JSR CLSLST
TRNE BDEV
JSR CLSBIN
JRST STRT1
;ROUTINES TO CLOSE VARIOUS FILES. SOME CARE IS NEEDED, ESPECIALLY IF WE
; PMAPPED THE FILE IN THE FIRST PLACE.
^CLSSRC: 0
TSVAC <1,2,3>
SKIPL 1,JFNTBL
JRST CLSSR1 ;IF NOT PMAPPABLE
SETO 1,
MOVE 2,[XWD 400000,SRCBFP]
SETZ 3,
PMAP ;OUT OF CORE
MOVE 1,JFNTBL
CLSSR1: HRRZS 1,1
TLO 1,400000 ;DO NOT RELEASE JFN!!! (ERROR HANDLING...)
CLOSF
JFCL ;I HOPE WE DON'T LAND HERE
TRSTAC <1,2,3>
JRST @CLSSRC
^CLSBIN: 0
TSVAC <1,2,3>
SKIPG ODB+2 ;WAS ANYTHING EVER WRITTEN?
JRST CLSBI1 ;NO. JUST CLOSE THE FILE.
SKIPL 1,JFNTBL-2+3 ;GET JFN. SKIP IF PMAPABLE
JRST CLSBI3 ;NOT PMAPPABLE
SETO 1, ;REMOVE FILE PAGE FROM CORE.
MOVE 2,[XWD 400000,BINBFP]
SETZ 3,
PMAP ;OUT OF CORE
MOVE 3,ODB ;CURRENT PAGE NUMBER
AOJ 3, ;PLUS 1 = PAGE COUNT
LSH 3,=9 ;TOTAL NUMBER OF BYTES IF FULL
SUB 3,ODB+2 ;MINUS NUM REMAINING
AOJ 3, ;PLUS ONE BECAUSE COUNT IS OFF
SETO 2, ;SET ALL BITS IN FDB WORD
HRR 1,JFNTBL-2+3 ;
HRLI 1,12 ;FDBSIZ,,JFN
CHFDB ;SET EOF WORD
CLSBI1: HRRZ 1,JFNTBL-2+3 ;JFN
CLOSF ;CLOSE AND RELEASE JFN
JFCL ;NO ERRORS I HOPE
SETZM JFNTBL-2+3
TRSTAC <1,2,3>
JRST @CLSBIN
CLSBI3: MOVE 3,ODB+2 ;BYTE COUNTER (# REMAINING)
SUBI 3,1001 ;3=-<NUMBER OF BYTES TO DUMP>
HRRZ 1,JFNTBL-2+3
HRROI 2,BINBF
SOUT ;DUMP BUFFER
JRST CLSBI1
^CLSLST: 0
TSVAC <1,2,3>
SKIPG LOB+2 ;ANYTHING EVER WRITTEN?
JRST CLSLS1 ;NO. NOTHING TO FORCE OUT
SKIPL 1,JFNTBL-2+4 ;GET JFN. SKIP IF PMAPPED
JRST CLSLS3 ;NOT PMAPPABLE
SETO 1, ;FORCE CURRENT PAGE FROM CORE
MOVE 2,[XWD 400000,LSTBFP]
SETZ 3,
PMAP ;OUT OF CORE
MOVE 3,LOB ;LAST PAGE NUMBER OF FILE
AOJ 3, ;PLUS 1 IS PAGE COUNT
IMULI 3,1000*5 ;TOTAL NUMBER OF BYTES IF FULL
SUB 3,LOB+2 ;MINUS NUM REMAINING
AOJ 3, ;ADD ONE SINCE COUNT IS OFF
SETO 2, ;SET ENTIRE WORD OF FILE SIZE
HRR 1,JFNTBL-2+4
HRLI 1,12 ;FDBSIZ,,JFN
CHFDB ;SET EOF
CLSLS1: HRRZ 1,JFNTBL-2+4
CLOSF
JFCL
SETZM JFNTBL-2+4
TRSTAC <1,2,3>
JRST @CLSLST
CLSLS3: MOVE 3,ODB+2 ;GET # OF BYTES REMAINING
SUBI 3,1000*5+1 ;3=-<NUMBER OF BYTES IN BUFFER>
HRRZ 1,JFNTBL-2+4
HRROI 2,LSTBF
SOUT ;DUMP BUFFER
JRST CLSLS1
>;TNX
EUOUT: BLOCK 2
ASCII /EF /
BLOCK 2
EN1: XWD 7,1
0
0
EN2: 5,,2
200000,,
0
0
;PRGEND -- DOES END STUFF & RESTARTS PAST I/O INITIALIZATION
^%PRGEN:PUSHJ P,DOEND ;SIMULATE END
HRROI TAC,[BYTE (7)14]
TRNE LDEV
PUSHJ P,LOUT ;DO PAGE HEADING IF NECC
JRST STRT2
;ROUTINE TO PUT OUT SYMBOLS IN REASONABLE FASHION.
;CALL IS WITH:
; FS RADIX 50 FOR SYMBOL.
; NA VALUE
; L IF NON-ZERO, RELOCATED.
BDOUT: XWD 2,22
0 ;RELOCATION INFORMATION
BLOCK 22 ;ROOM FOR MANY MANY SYMBOLS.....
BNPT: ASCII / /
BLOCK 3
ASCII / /
SBOUT:
PUSH P,O ;NEED AN AC.
AOS BDOUT
AOS O,BDOUT
MOVEM FS,BDOUT(O) ;NAME.
MOVEM NA,BDOUT+1(O) ;VALUE
TRZ L,12
TRZE L,4 ;CHANGE RELOCATION BITS.
TRO L,2
IDPB L,BYTPT ;STORE SAME.
CAME O,[XWD 2,22] ;DONE?
JRST STSQM ;DONE THIS SOON.
PUSH P,SBRRT ;RETURN FROM SBFRC TO STSYM
SBFRC: PUSH P,TAC
PUSH P,BC
MOVEI BC,BDOUT
HRRZ TAC,BDOUT ;COUNT
TRNN TAC,-1
JRST SBDON
MOVNS TAC ;- COUNT.
HRLI BC,-2(TAC) ;NEW COUNT.
PUSHJ P,GBOUT ;WRITE IT OUT.
SBDON: POP P,BC
POP P,TAC
SBRRT: POPJ P,STSYM ;(RETURN ADDRESS FOR FALL THRU CALL)
^SBINI: PUSH P,O ;HERE TO INITIALIZE SYMBOL TABLE OUTPUT
STSYM: HLLZS BDOUT ;RESTART COUNT.
MOVE O,[POINT 4,BDOUT+1]
MOVEM O,BYTPT ;RESTART BYTE POINTER.
STSQM: POP P,O
POPJ P,
BYTPT: 0
BEGIN BEND
^EBEND: SKIPN UNIVSW ;CALLED FROM DOEND. SET UP FOR UNIVERSAL
JRST BEND ;NOTHING SPECIAL
SETZM U.OPC ;CLEAR POINTERS TO CHAINS OF SYMBOLS.
SETZM U.MAC
SETZM U.SYM
MOVEI O,U.MAC ;FOR UNIVERSALS, WE DON'T GIVE THINGS
MOVEM O,US.M ; AWAY TO FREE STORAGE, BUT WE MAKE OUR
MOVEI O,U.OPC ; OWN LISTS INSTEAD.
MOVEM O,US.O
MOVEI O,U.SYM
MOVEM O,US.S
MOVE O,[HLLM FS,1(N)]
MOVEM O,OLOPX# ;HACK TO FIXUP OPCODES
MOVSI O,(<JFCL>) ;SET MLOPX INSTRUCTION FOR GIVING BACK MACROS.
NOTNX,< JRST BEND.1 >
TNX,< PUSHJ P,BEND.1 ;PERFORM USUAL FUNCTIONS OF BEND
MOVSI NA,-HASH ;CHASE THRU OPCODE TABLE AND EMIT JSYS'S
EBEND1: SKIPN N,OPCDS(NA)
JRST EBEND4 ;EMPTY CHAIN
PUSH P,NA
EBEND2: SKIPLE FS,1(N) ;SKIP IF PSEUDO-OP (OR SOME MACHINE OPS)
TLNN FS,20 ;NOT PSEUDO. SKIP IF OPDEF.
JRST EBEND3
PUSH P,N
MOVE FS,(N) ;GET SYMBOL NAME
SKIPE CREFSW
CREF66 13,(N) ;EMIT TO CREF
PUSHJ P,R5CON
POP P,N
TLO FS,100000
MOVE NA,3(N) ;GET VALUE
MOVE L,4(N)
PUSHJ P,SBOUT ;EMIT SYMBOL
EBEND3: HRRZ N,1(N)
JUMPN N,EBEND2
POP P,NA
EBEND4: AOBJN NA,EBEND1
POPJ P,>
^^BEND: MOVEI O,FSTPNT ;(SEE EBEND FOR WHAT HAPPENS TO UNIVERSALS)
MOVEM O,US.S ;ADDRESS OF "FREE STORAGE LIST" FOR SYMBOLS
MOVEM O,US.M ; FOR MACROS
MOVEM O,US.O ; FOR OPCODES
MOVSI O,(<JFCL>)
MOVEM O,OLOPX
MOVE O,[PUSHJ P,MACRET]
BEND.1: MOVEM O,MLOPX# ;SET INSTRUCTION FOR RETURNING MACRO SPACE
MOVE NA,BLOCK
SUBI NA,1 ;FORM WORD WITH ALL...
MOVEM NA,OBLK ;HIGHER LEVEL BITS ON
MOVE NA,BLOCK
LSH NA,-1 ;FORM WORD WITH NEXT...
MOVEM NA,BLOCKN ;BIT ON
MOVE NA,BLOCK ;GET BLOCK...
FAD NA,[0] ;NUMBER
LDB NA,[POINT 8,NA,8]
MOVE FS,BNAM-347(NA) ;GET NEXT BLOCK NAME UP
CAILE NA,346 ;AVOID MISTAKE AT END
MOVEM FS,LSTLAB+3 ;DEP FOR ERROR PRINT
MOVE FS,BNAM-346(NA) ;GET BLOCK NAME
PUSHJ P,R5CON ;CON TO R5
TLO FS,140000
SUBI NA,345
PUSH P,L
SETZM L ;NO RELOCATION.
PUSHJ P,SBOUT ;OUTPUT SYMBOL.
POP P,L
MOVE FS,BNAM-1(NA) ;GET NAME
MOVEM FS,NMBLK ;SAVE THE NAME
SKIPE CREFSW ;CREF?
CREF7 16,FS ;YES
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,BNPT+2 ;DEPOSIT
ORI FS,20000+22
MOVEM FS,BNPT+3
IDIVI NA,12 ;CONVERT LEVEL TO...
ORI PN,60 ;DECIMAL...
SKIPN NA ;...
SUBI NA,20
ADDI NA,60 ;...
DPB PN,[POINT 7,BNPT+4,13] ;AND..
DPB NA,[POINT 7,BNPT+4,6] ;DEPOSIT
MOVE NA,MTBPNT ;SET UP...
MOVEM NA,SPNT ;FOR PSYM
MOVEM NA,SSPNT ;...
SETZM SCOUNT ;...
SETOM MERCNT ;INIT MULT...
MOVEI NA,MERSTR ;DEF. LAB...
MOVEM NA,MERPNT ;MESSAGE AREA
;HERE WE CHASE THRU THE SYMBOLS AND PASS THE LOCAL ONES TO THE LOADER
SKIPN XPUNGS ;ARE WE EXPUNGING SYMBOLS?
SKIPA O,[PUSHJ P,SBOUT] ;NO. REPAIR INSTRUCTIONS BELOW.
MOVSI O,(<JFCL>) ;YES. NO-OP INSTRUCTIONS BELOW.
MOVEM O,IXPUNG# ;SET INSTR. TO BE XCT'D
MOVEI NA,HASH ;INITIAL SYMTAB COUNTER
LOOP1: MOVEM NA,NASAV ;SAVE
MOVEI NA,SYMTAB-1(NA) ;GET FIRST OF CHAIN
SKIPN O,(NA)
JRST NONC ;NONE
LOOP2: MOVE N,2(O) ;GET FLAGS
TDNN N,BLOCK ;THIS BLOCK?
JRST NOTHS ;NO. SKIP TO THE NEXT SYMBOL
TLNE N,UDSF ;IS THIS A DEFINED-UNDEFINED?
JRST LITLAB ;YES, SPECIAL CODE FOR ALL OF IT
TLNE N,DEFFL ;DEFINED?
JRST NODEF ;NO
TLNE N,DAF!GLOBF ;IS IT GLOBAL OR DOWN ARROW?
JRST DGLOB ;YES
CONT: SKIPE SYMOUT ;SYMBOL TABLE LISTING?
JRST [TLNN N,SUPBIT ;YES. BUT IS THIS SUPPRESSED?
PUSHJ P,PSYM ;NOT SUPPRESSED. LIST THIS.
JRST .+1]
TLNE N,INTF ;INTERNAL?
JRST UPAR1 ;YES. DEFER EMISSION 'TIL LATER
TLNE N,UPARF ;UPARROW?
SKIPN BLOCKN ;AND NOT AT OUTER LEVEL
SKIPA
JRST UPAR1 ;THEN DO NOT PUT OUT DEF
MOVE FS,(O) ;GET SIXBIT
SKIPE CREFSW
CREF66 11,(O)
PUSHJ P,R5CON ;CON TO R5
TLO FS,100000 ;BITS
MOVE N,2(O) ;GET FLAGS
TLNE N,DBLF ;__?
TLO FS,SNB ;YES -SET BIT TO SUPPRESS THE SYMBOL
PUSH P,NA
MOVE NA,3(O) ;GET VALUE
MOVE L,4(O) ;GET RELOC
ITS,< TLNE N,ANONF ;DON'T PUT IT OUT IF ANONYMOUS
JRST CONT1>
TLNN N,SUPBIT ;SKIP IF WE SHOULD SUPPRESS THIS SYMBOL.
XCT IXPUNG ;PUSHJ P,SBOUT, OR JFCL IF XPUNGS IS SET!
CONT1: POP P,NA
TLNE N,UPARF ;EMIT THIS LATER (WHY??)
JRST UPAR1 ;(SEE ELOOP3)
DEL: MOVE T,@US.S ;GET FREE STRG PNTR. (FSTPNT, UNLESS UNIVERSALS)
EXCH T,1(O) ;PUT THIS BACK ON FREE STRG.
MOVEM O,@US.S ;...
DEL2: MOVEM T,(NA) ;& REMOVE FROM CHAIN
SKIPE O,T ;ANY MORE?
JRST LOOP2 ;YES
NONC: SOSLE NA,NASAV ;GET NEXT SYMTAB CHAIN
JRST LOOP1
;HERE WE CHASE THRU THE OPCODE TABLE AND EMIT USER'S OPDEFS TO THE LOADER.
LDON: PUSH P,B
PUSH P,C
MOVEI NA,HASH ;PREPARE TO CUT BACK OPDEFS.
MOVE T,BLOCK ;TEST WORD
MOVSI FS,20 ;@ BIT - SIGNIFIES OPDEF
OLOP1: SKIPN N,OPCDS-1(NA) ;GET FIRST CHAIN
JRST NONT ;NONE
OLOP: TDNE FS,1(N) ;ORDINARY OP?
SKIPGE 1(N) ;NO. MAYBE A PSEUDO-OP?
JRST ENDF ;YES. STOP HERE. (MACHINE OPS AND CALLI'S LEFT)
TDNN T,2(N) ;THIS BLOCK?
JRST ENDF ;NO, QUIT (GET THIS LATER)
PUSH P,N ;SAVE POINTER
MOVE FS,(N) ;GET OPDEF NAME
SKIPE CREFSW
CREF66 13,(N)
PUSHJ P,R5CON ;TO RADIX50 FOR DDT
POP P,N
TLO FS,100000 ;SET AS LOCAL
PUSH P,NA ;SAVE IT.
PUSH P,L
MOVE NA,3(N) ;GET VALUE
MOVE L,2(N) ;GET FLAGS
NOITS,< TLNE L,SUPBIT ;SUPPRESSED? >;NOITS
ITS,< TLNE L,ANONF!SUPBIT ;SUPPRESSED OR ANONYMOUS? >;ITS
JRST OLOP2 ;YES. DON'T EMIT TO LOADER
MOVE L,4(N) ;GET VALUE
XCT IXPUNG ;PUSHJ P,SBOUT, OR IF XPUNGES IS SET, JFCL
OLOP2: POP P,L
POP P,NA
OLOP3: MOVSI FS,20 ;REPAIR FS.
MOVE O,@US.O ;ADD THIS OPCODE TO FREE STORAGE, OR TO UNIVERSALS
EXCH O,1(N)
MOVEM N,@US.O ;PUT BACK IN FREE STRG
XCT OLOPX ;JFCL, OR HLLM FS,1(N), IF UNIVERSAL
HRRZ N,O ;GET NEXT
JUMPN N,OLOP ;ANY MORE?
ENDF: MOVEM N,OPCDS-1(NA)
NONT: SOJG NA,OLOP1 ;CONTINUE WITH NEXT CHAIN
SETZM XPUNGS ;NO LONGER EXPUNGING
PUSHJ P,SBFRC ;FORCE THE SYMBOLS OUT NOW
PUSHJ P,SBINI ;REINITIALIZE SYMBOL OUTPUT
;AND HERE WE CHASE THRU THE MACROS, EMITTING THEIR NAMES TO CREF, RECLAIMING SPACE
MOVEI NA,HASH ;PREPARE TO CUT BACK MACROS
MLOP1: SKIPN N,MACRT-1(NA) ;GET BASE OF CHAIN
JRST MLOP4 ;CHAIN IS EMPTY
MLOP2: TDNN T,2(N) ;MACRO BELONGS TO THIS BLOCK?
JRST MLOP3 ;NO. NOTHING LEFT TO DO ON THIS CHAIN
SKIPE CREFSW
CREF66 13,(N)
MOVE C,4(N) ;GET START
HLRZ B,(C) ;GET LENGTH
ADD B,C ;GET END
XCT MLOPX ;GIVE BACK MACRO SPACE. (PUSHJ P,MACRET, OR JFCL)
MOVE O,@US.M ;PUT BACK ON FREE STRG. (OR GIVE TO UNIVERSAL)
EXCH O,1(N) ;STOR FS ADDRESS IN THIS BLOCK. ADDRESS OF NEXT IN O
MOVEM N,@US.M ;STORE ADDRESS OF THIS BLOCK IN FS HEADER
SKIPE N,O ;LINK TO NEXT.
JRST MLOP2 ;LOOP IF THERE'S MORE TO DO.
MLOP3: MOVEM N,MACRT-1(NA) ;STORE NEW LINK TO MACRO LIST
MLOP4: SOJG NA,MLOP1 ;GET NEXT CHAIN
MOVE N,BLOCK ;FORM NEXT-OUTER BLOCK BITS
LSH N,-1 ;BLOCK...
MOVEM N,BLOCK
MOVN N,N ;TWOS COMPLEMENT TO FORM DBLCK
HRLI N,DAF
MOVEM N,DBLCK ;DBLCK
SKIPE SYMOUT ;SYMBOL LISTING?
PUSHJ P,PSYMGO ;YES
TRAN BNPT ;LIST BLOCK NAME
POP P,C
POP P,B
POPJ P,
;HERE FOR INTERNALS, OR UP-ARROWED SYMS. MOVE SYMBOL OUT ONE BLOCK
UPAR1: MOVE L,(O) ;GET SIXBIT OF CURRENT SYMBOL
SKIPN PN,1(O) ;ANY MORE?
JRST UPAR
MOVE T,O
UPAR1A: CAMN L,(PN) ;LOOK FOR ANOTHER SYMBOL WITH THE SAME NAME AS THIS.
JRST UNFD ;HERE WE HAVE ANOTHER ONE WITH THE SAME NAME.
MOVE T,PN
SKIPN PN,1(PN)
JRST UPAR
JRST UPAR1A ;PN POINTS TO SYMBOL. T= ADDR OF CELL THAT POINTS AT PN
UNFD: MOVEM T,SVLNK ;SAVE LINK (THIS IS NEEDED TO DELINK SYMBOL.
MOVE T,2(PN) ;GET FLAGS
TDNN T,BLOCKN ;NEXT BLOCK?
JRST UPAR ;NO. WE JUST GO MOVE THIS OUT ONE BLOCK
TLNN T,UDSF ;OR IF DEFINED-UNDEFINE
TLZN T,DEFFL ;DEFINED?
JRST MERR ;YES
TLNE N,DBLUPF
TRZA N,-1 ;DON'T CLEAR ^ FLAG IF ^^
TDZ N,[XWD UPARF,-1]
OR T,N ;TRANSFER BITS
TLZE T,EXTF ;IF OUTER BLOCK SYMBOL WAS EXTERNAL,
TLO T,INTF ; IT BECOMES INTERNAL
TLNE T,UDSF
JRST [MOVEM T,2(O)
MOVE T,SVLNK ;ELIM UPPER BLOCK
MOVE N,FSTPNT ;GET SECOND BLOCK ONTO FREE STORAGE
EXCH N,1(PN)
MOVEM N,1(T)
MOVEM PN,FSTPNT
EXCH PN,O ;EXCHANGE SO FIXUP COMBINE DONE RIGHT
JRST UPNOD1] ;AND AWAY WE GO
MOVEM T,2(PN) ;DEPOSIT
EXCH PN,O
SKIPE N,3(O) ;FIXUPS?
PUSHJ P,GFIX ;YES
SKIPE N,4(O) ;POL-FIXES?
PUSHJ P,PFIX ;YES
EXCH PN,O
SKIPN CREFSW
JRST .+3
CREF6 10,(O) ;COMBINE TWO CHAINS
CREF6 0,(PN)
HRLI N,3(O) ;DEFINE..
HRRI N,3(PN) ;IT ...
BLT N,4(PN) ;ABOVE
JRST DEL ;AND DELETE IT BELOW
MERER: ASCII /MULTIPLY DEFINED BY ^
/ ;PRECISELY A MULTIPLE OF 5 CHARS.
MERSTR: BLOCK 57
MEREND: BLOCK 4
MERCNT: 0
MERPNT: 0
MERR: AOSN MERCNT ;ANY YET?
ERROR MERER ;NO, THIS IS FIRST
MOVE FS,MERPNT
CAIL FS,MEREND ;IS TABLE TOO FULL?
JRST MERR1 ;YES, ADD ENDING MESSAGE.
MOVE FS,(PN) ;NO, GET SIXBIT
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,@MERPNT ;DEPOSIT
AOS MERPNT ;INCREMENT
OR FS,[BYTE(7)0,40,40,15,12]
MOVEM FS,@MERPNT ;DEPOSIT
AOS MERPNT ;INCREMENT
SETZM @MERPNT ;MAKE SURE IT GETS STOPPED.
JRST DEL
MERR1: MOVE T,[ASCII/MORE /]
MOVEM T,(FS)
MOVE T,CRLF
MOVEM T,1(FS)
JRST DEL
UPAR: HRRES N ;GET BLOCK BIT
LSH N,-1 ;SHIFT
HLL N,2(O) ;GET FLAGS
TLNN N,DBLUPF ;NOT IF DOUBLE UP ARROW.
TLZ N,UPARF ;CLEAR UPARROW BIT
MOVEM N,2(O) ;REDEPOSIT
NOTHS: MOVEI NA,1(O) ;PASS THIS ONE...
SKIPE O,1(O) ;AND LEAVE...
JRST LOOP2 ;ALONE
JRST NONC ;NO MORE THIS CHAIN
DGLOB: TDNN N,OBLK ;ANY OTHER BLOCK BITS ON?
JRST CONT ;NO
GLB1: TLNN N,DAF ;DOWN-ARROW?
TDZ N,BLOCK ;NO, GLOBAL, TURN OFF THIS BIT
MOVEM N,2(O) ;DEPOSIT
JRST NOTHS
;HERE WE'RE LEAVING A BLOCK, AND AN UDEFINED SYMBOL HAS BEEN REFERENCED
NODEF: MOVE L,(O) ;GET SIXBIT
SKIPN PN,1(O) ;ANY MORE?
JRST UPAR ;NO. THERE IS NO OTHER DEFINITION OF THIS SYMBOL
SRC1 (L,PN,NFND,JRST UPAR)
NFND: MOVE T,2(PN) ;GET FLAGS
TDNN T,BLOCKN ;NEXT BLOCK UP?
JRST UPAR ;NO. WE MOVE THIS SYMBOL ONE BLOCK OUT
TLNE T,DEFFL ;DEFINED?
JRST UPNOD ;NO. MOVE IT OUT, MERGING WITH OTHER FIXUPS
TLNE T,UDSF ;UNDEFINED - DEFINED SYMBOL
JRST MERR ;YES (I DON'T UNDERSTAND HOW THIS CAN HAPPEN - REG)
SKIPN CREFSW ;SYMBOL HAS BEEN DEFINED IN OUTER BLOCK.
JRST .+3
CREF6 10,(O)
CREF6 0,(PN)
SKIPE N,3(O) ;ANY FIXUPS?
PUSHJ P,GFIX ;YES, PUT OUT
SKIPE N,4(O) ;ANY POLFIXES?
PUSHJ P,PFIX ;YES, DO
JRST DEL ;NOW, FLUSH THE SYMBOL DEFINITION
;HERE THE SYMBOL IS UNDEFINED IN THE NEXT-OUTER BLOCK. MERGE FIXUPS
UPNOD: MOVE L,2(O) ;GET FLAGS
AND L,[XWD EXTF!INTF!VARF!UDSF,0]
ORM L,2(PN) ;DEPOSIT CERTAIN FLAGS
UPNOD1: SKIPN CREFSW ;MERGE O-SYMBOL FROM INNER WITH PN-SYMBOL FROM OUTER
JRST .+3
CREF6 10,(O)
CREF6 0,(PN)
SKIPN L,3(O) ;ANY FIXUPS
JRST AHD ;NO. DO POLISH FIXUPS
MOVE T,3(PN) ;SAVE FIXUPS FROM OUTER BLOCK SYMBOLS
MOVEM L,3(PN) ;STORE INNER BLOCK FIXUPS IN OUTER BLOCK SYMBOL
ALOP: SKIPN FS,1(L) ;FIND THE END OF THE INNER BLOCK FIXUPS.
JRST EFND ;GOT IT 1(L) IS THE END OF THE INNER FIXUP LIST
MOVE L,FS ;LINK ON
JRST ALOP
EFND: MOVEM T,1(L) ;APPEND OUTER BLOCK FIXUP LIST TO THE END OF FIXLIST
AHD: SKIPN L,4(O) ;REPEAT THE ABOVE FOR POLFIXES
JRST PFND1
MOVE T,4(PN)
MOVEM L,4(PN)
MOVSS L
PLOP: MOVEM PN,(L) ;EXCEPT LINK IS THE LEFT HALF OF THIRD WORD
SKIPN FS,2(L) ;AND WE STORE THE NEW SYMBLOCK (PN) IN EACH POLFIX
JRST PFND
MOVS L,FS
JRST PLOP
PFND: MOVEM T,2(L) ;OTHER
PFND1: MOVE T,2(PN) ;MORE FLAGS
CAME O,FSTPNT ;THIS WILL BE TRUE ONLY IF WE CAME FROM ^UDSF (UNFD)
JRST DEL
EXCH PN,O
JRST NOTHS ;SKIP DELETING THIS
OBLK: 0
NASAV: 0
BLOCKN: 0
NMBLK: 0
SVLNK: 0
LITLAB: TLNE N,DAF!GLOBF ;BOY ARE THESE A PAIN
JRST LITGLB
SKIPE SYMOUT
PUSHJ P,PSYM
TLNE N,INTF!UPARF ;BUT THESE ARE WORSE
JRST UPAR1 ;BECAUSE OF THE PAIN THEY CAUSE HERE
LITCNT: MOVE FS,(O) ;GET SIXBIT
SKIPE CREFSW
CREF66 11,(O)
PUSHJ P,R5CON
TLO FS,100000 ;SET TO LOCAL
MOVSI N,SYMFIX ;SAY WE NEED SYMBOL TABLE FIXUP
IORB N,2(O) ;GET FLAGS
TLNE N,DBLF
TLO FS,SNB ;SET DELETE FLAG (HALF KILLED)
PUSH P,L
PUSH P,NA
SETZB L,NA
PUSHJ P,SBOUT
POP P,NA
POP P,L
MOVE T,NMBLK
EXCH T,1(O) ;PUT BLOCK NAME IN
JRST DEL2 ;GO FINISH THE DELETE
LITGLB: TDNN N,OBLK
JRST LITCNT
JRST GLB1
;SYMBOL TABLE LISTING. PSYM, PSYMGO
SNBN__377777
;ENTER HERE TO INCLUDE ONE SYMBOL IN SYMBOL TABLE LISTING. POINTER TO SYM IN O
PSYM: TRNN LDEV ;LIST DEV?
POPJ P, ;NO
HRRZ T,SPNT ;DESTINATION FOR BLT
HRLI T,2(O) ;SOURCE FOR BLT
MOVEI L,3 ;INCREMENT SPNT FOR NEXT SYMBOL
ADDB L,SPNT
LEG SETZM -1(L) ;ADDRESS CHECK THE BLT AND EXPAND CORE IF NEEDED
BLT T,-1(L) ;SAVE VALUES
SKIPA T,(O) ;GET SIXBIT
LSH T,6
TLNN T,770000 ;LEFT ADJUST SIXBIT
JRST .-2
TLC T,SNB ;INVERT SIGN FOR COMPARE
MOVEM T,-3(L) ;DEPOSIT
AOS SCOUNT ;COUNT ONE MORE SYMBOL SEEN
POPJ P,
;HERE TO SORT THE SYMBOLS AND OUTPUT THEM. (ANOTHER LOSING N-SQUARED SORT)
PSYMGO: SKIPN SCOUNT ;ANY SYMBOLS TO LIST?
POPJ P, ;NO
PUSHJ P,LSTCHK
MOVEI TAC,CRLF
PUSHJ P,LOUT
SLOOP2: HRLOI FS,SNBN ;INIT - LARGEST POSSIBLE NUMBER
MOVE NA,SCOUNT ;GET COUNT
MOVE PN,SSPNT ;GET START OF SYMBOLS
SLOOP1: CAMG FS,(PN) ;COMPARE
JRST SPT1 ;NEW ONE LARGER
MOVE N,PN ;SAVE POINTER
MOVE FS,(PN) ;GET NEW SIXBIT
SPT1: ADDI PN,3 ;GO TO NEXT
SOJG NA,SLOOP1 ;LOOP
CAMN FS,[SNBN,,-1] ;DONE?
JRST [MOVEI TAC,CRLF ;YES. RETURN
JRST LOUT]
HRLOI NA,SNBN ;REMOVE...
MOVEM NA,(N) ;THIS ONE
TLC FS,SNB ;REINVERT SIGN
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,SOUTX ;DEPOSIT
TLO FS,220 ;PUT IN TAB
MOVEM FS,SOUTX+1 ;DEPOSIT
MOVS FS,1(N) ;GET VALUE...
MOVE TAC,2(N) ;& RELOC
SETZM SOUTX+2
MOVEI T,22 ;ANOTHER TAB
MOVEM T,SOUTX+3
TRNN FS,-1 ;LEFT HALF =0?
JRST SPT2 ;YES
MOVSS FS ;GET LEFT HALF
LSH TAC,-2 ;& RELOC
PUSHJ P,OCON ;CON TO OCTAL ASCII
MOVEM T,SOUTX+2 ;DEPOSIT
MOVEM FS,SOUTX+3 ;...
MOVS FS,1(N) ;GET RIGHT HALF
MOVE TAC,2(N) ;& RELOC
SPT2: PUSHJ P,OCON ;CONVERT
MOVEM T,SOUTX+4 ;DEPOSIT
MOVEM FS,SOUTX+5 ;...
MOVE TAC,[XWD -7,SOUTX]
PUSHJ P,LOUT ;OUTPUT IT
JRST SLOOP2
SOUTX: BLOCK 6
BYTE (7)15,12
;AFROM6: CONVERTS 6-BIT TO ASCII. CALL WITH 6-BIT IN FS.
; RETURNS ASCII IN T & FS.
^^AFROM6:
MOVEI T,0
ALE1: LSHC T,6 ;GET CHR.
TRCE T,40 ;CON TO ASCII
TRO T,100 ;...
LSH T,1 ;LEAVE ROOM
TLNN T,700000 ;5 CHRS?
JRST ALE1 ;NO
LSH FS,-1 ;ADJUST FINAL CHR.
TLCE FS,200000 ;CON TO ...
TLO FS,SNB ;ASCII
POPJ P,
SCOUNT: 0
SPNT: 0
SSPNT: 0
BEND BEND
BEND ENDS
; BEGIN AND BEND
%BEG: MOVE N,BLOCK ;GET BLOCK...
TRNE N,600000 ;LEGAL BEGIN?
ERROR[ASCIZ/BLOCKS NESTED TOO DEEP/]
LSH N,1 ;SHIFT
MOVEM N,BLOCK ;RESTORE
MOVNS N ;FORM DBLK (MASK FOR ALL LOWER BLOCKS)
HRLI N,DAF ;...
MOVEM N,DBLCK ;...
AOS %BCUR ;INCREMENT COUNT OF BEGINS
PUSHJ P,SCAN ;GET NAME, IF ANY
TLNE IFLG ;IDENT?
JRST %BPT ;YES
MOVE L,['A.000'];GET BASIC
MOVE FS,%BCUR ;GET CURRENT NUM
DPB FS,[POINT 3,L,35]
LSH FS,-3
DPB FS,[POINT 3,L,29]
LSH FS,-3
DPB FS,[POINT 3,L,23]
%BPT: MOVEM L,LSTLAB+3 ;DEPOSIT FOR ERROR MESSAGE PRINTER
MOVE T,BLOCK
FAD T,[0]
LDB T,[POINT 8,T,8];GET NUM
MOVEM L,BNAM-346(T);DEPOSIT NAME
SKIPE CREFSW ;CREF?
CREF7 15,L ;YES
MOVE FS,L ;GET NAME
MOVE NA,T
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,%BQ+2 ;DEPOSIT
ORI FS,20022 ;...
MOVEM FS,%BQ+3 ;...
SUBI NA,345 ;GET LEVEL NUMBER
IDIVI NA,12 ;CON TO...
SKIPN NA ;DECIMAL...
SUBI NA,20 ;...
ADDI NA,60 ;...
ADDI PN,60 ;...
DPB NA,[POINT 7,%BQ+4,6]
DPB PN,[POINT 7,%BQ+4,13]
TRAN %BQ ;LIST BLOCK NAME & LEVEL
JRST NSPCFN
%BCUR: 0
%BQ: ASCII / /
BLOCK 3
ASCII / /
%BEND: MOVE T,BLOCK
SOJLE T,BERR ;BARF IF ALREADY OUTER BLOCK
PUSHJ P,SCAN ;GET OPTIONAL BLOCK NAME
TLNN IFLG
JRST BENDNA
MOVE T,BLOCK
FSC T,32
ROT T,9
CAME L,BNAM(T)
ERROR [ASCIZ /BLOCK NAME MISMATCH/]
BENDNA: PUSH P,N
PUSHJ P,BEND
POP P,N
JRST NSPCFN
BERR: ERROR [ASCIZ /TOO MANY BENDS/]
JRST NSPCFN
BEGIN LITOUT SUBTTL LITOUT OUTPUT LITERALS, VARIABLES
^LITOUT:
MOVSI O,-HASH
LITLP0: SKIPN NA,LITPNT(O) ;ANYTHING TO DO HERE?
JRST LITLP1 ;NO.
PUSH P,O ;SAVE INDEX TO LITPNT
IFE DWPSW,< PUSHJ P,LITSRT > ;SORT LITERALS. IDENTICAL ONES ARE MERGED
LOP2: MOVE O,1(NA) ;GET NEXT LITERAL
HLRZ L,2(NA) ;ANY LABELS?
JUMPE L,NOLBS ;NO
PUSH P,O
PUSH P,NA
MOVE O,L
PT1: MOVE PN,4(O) ;GET POINTER TO SYMBOL TABLE ENTRY
MOVE N,PCNT ;GET VALUE
MOVE NA,PCNT+1
ADD N,3(O) ;ADD COUNT
PUSHJ P,LVDEF ;DEFINE IT
MOVE N,FSTPNT
SKIPE (O) ;CHECK FOR $. KLUDGE
JRST LLOK ;NOPE
MOVEM N,1(PN) ;RETURN "SYM" TO FS
MOVEI N,(PN)
LLOK: EXCH N,1(O) ;NOW RET LITLAB BLK
MOVEM O,FSTPNT
SKIPE O,N
JRST PT1
POP P,NA ;RESTORE
POP P,O
NOLBS: MOVEI PN,PCNT-3 ;SET UP "VALUE" POINTER FOR GFIX
SKIPE N,3(NA) ;GET FIXUP POINTER
PUSHJ P,GFIX ;PUT OUT FIXUPS
SKIPE N,4(NA)
PUSHJ P,PFIX
MOVE N,FSTPNT ;GET FREE STRG
MOVEM N,1(NA) ;PUT THIS BACK ON FREE STRG
MOVEM NA,FSTPNT ;...
HRRZ L,2(NA) ;GET VALUES
LOP1: SKIPN 4(L) ;ANYTHING HERE?
JRST LPT3 ;NO
HRLI PN,3(L) ;GET POINTER TO VALUE
HRRI PN,WRD
BLT PN,WRD+1 ;PUT IN WRD
PUSHJ P,BLOUT ;LIST VALUE
OUTP 3(L) ;OUTPUT VALUE
SKIPN N,(L) ;REVERSE FIXUP?
JRST LPT1 ;NO
JUMPGE N,.+3 ;POLISH FIXUP?
PUSHJ P,POLHAN ;YES, HANDLE
JRST LPT1
HRRI TAC,3(N)
HRLI TAC,OPCNT
BLT TAC,4(N) ;SET FIXUP WHICH POINTS HERE
; TO POINT TO CORE
LPT1: SKIPN N,2(L) ;REVERSE FIXUP, LEFT HALF?
JRST LPT2 ;NO
JUMPGE N,.+3
PUSHJ P,POLHAN
JRST LPT2
HRRI TAC,3(N)
HRLI TAC,OPCNT
BLT TAC,4(N) ;SET THIS ONE
LPT2: AOS OPCNT ;INCREMENT
MOVE N,OPCNT
CAMGE N,BRK
JRST .+5
CAMGE N,HICNT
JRST .+5
MOVEM N,HICNT
JRST .+3
CAML N,@CURBRK
MOVEM N,@CURBRK
AOS PCNT ;...
LPT3: MOVE N,FSTPNT
EXCH N,1(L) ;PUT THIS BACK...
MOVEM L,FSTPNT ;IN FREE STRG.
SKIPE L,N ;ANY MORE
JRST LOP1 ;YES
SKIPE NA,O ;GET NEXT LITERAL, MORE?
JRST LOP2 ;THERE ARE MORE
POP P,O ;RESTORE INDEX TO LITPNT
SETZM LITPNT(O) ;CLEAR CHAIN
LITLP1: AOBJN O,LITLP0
POPJ P,
POLHAN: MOVE TAC,OPCNT ;GET PLACE WHERE THIS IS...
MOVEM TAC,2(N) ;GOING & MAKE POLFIX...
MOVE TAC,OPCNT+1 ;POINT THERE
MOVEM TAC,3(N)
SKIPLE 1(N) ;NO UNDEF SYMS LEFT?
POPJ P, ;SOME LEFT
MOVEI FS,5(N) ;SET UP POINTER
PUSH P,O ;SAVE
PUSH P,L
PUSHJ P,REDUC ;REDUCE THE POLISH
PUSHJ P,BFRC ;FORCE OUT BINARY
MOVEI FS,5(N) ;SET UP POINTER
PUSHJ P,POLOUT ;PUT OUT POLFIX
POP P,L
POP P,O
POPJ P,
;SORT THE LITERALS. DO CONTANT'S OPTIMIZATION.
LITSRT: JUMPE NA,CPOPJ ;NO WORK FOR NO LIST
SKIPN FS,1(NA) ;GET LINK TO NEXT
POPJ P, ;NO NEXT. - A ONE-ELMENT LIST IS SORTED.
;NA AND FS WILL BE NEARLY-EQUAL LENGTH LISTS
MOVE O,FS ;TAIL OF THE FS LIST
MOVE L,NA ;TAIL OF THE NA LIST
LITSR1: MOVE N,1(O) ;GET LINK-OUT OF FS LIST
MOVEM N,1(L) ;STORE AS LINK-OUT IN NA LIST
SKIPN L,N ;ADVANCE NA-TAIL
JRST LITSR2 ;NO NEXT
MOVE N,1(L) ;GET LINK-OUT OF NA-LIST
MOVEM N,1(O) ;STORE AS LINK-OUT OF FS-LIST
SKIPE O,N ;ADVANCE FS-TAIL
JRST LITSR1 ;MAKE LISTS OF ALTERNATE ELEMENTS.
LITSR2: PUSH P,FS ;SAVE FS-LIST
PUSHJ P,LITSRT ;SORT THE NA-LIST (RECUR UNTIL DONE)
EXCH NA,(P) ;EXCH SORTED LIST WITH FS-LIST
PUSHJ P,LITSRT ;AND SORT FS-LIST
POP P,FS ;(FS AND NA ARE INTERCHANGED, BUT WHO CARES)
;FS AND NA NOW (ASSUME) POINT TO SORTED LISTS. MERGE THEM INTO ONE LIST.
MOVEI L,O-1 ;MERGE LIST HEAD IN O
JUMPE NA,LITSR4 ;NO MERGE IF NA IS EMPTY. ADD FS TO OUT-LIST
EXCH NA,FS ;SWAP THEM (WHO CARES?)
JUMPE NA,LITSR4 ;NO MERGE IF NA IS EMPTY. ADD FS TO OUT-LIST
LITSR3: PUSHJ P,LCOMP ;COMPARE CAR(FS) AND CAR(NA).
; RETURN SMALLEST IN NA
MOVEM NA,1(L) ;NA<FS. ADD CAR(NA) TO OUT-LIST
MOVEI L,(NA) ;ADVANCE END OF OUT-LIST.
SKIPE NA,1(NA) ;FORM CDR(NA)
JRST LITSR3 ;CONTINUE THE MERGE
LITSR4: MOVEM FS,1(L) ;STORE OTHER LIST IN THE OUT-LIST
MOVE NA,O ;GET THE ADDRESS OF THE LIST-HEAD
POPJ P, ;RETURN, POINTER TO SORTED LIST IN NA
;LCOMP - COMPARE CAR(NA) AND CAR(FS).
;EXIT ROUTINES...
;CALLED BY CAME TAC,... JSP T,NOSAME. TAC CONTAINS NA-DATA.
NOSAME: CAML TAC,@-2(T) ;DO THE COMPARE AGAIN. SKIP IF NA<FS
EXCH NA,FS ;MAKE NA<FS
POPJ P,
;HERE IF THEY'RE NOT THE SAME, BUT CAN'T DECIDE SORTING-ORDER. COMPARE ADDRESSES
NOSAM1: CAML NA,FS ;USE LITERAL'S ADDRESS TO RESOVE AMBIGUITY
EXCH NA,FS ;MAKE NA<FS
POPJ P,
LCOMP: MOVE TAC,(NA) ;COMPARE LITERALS AT NA AND FS.
CAME TAC,(FS) ;ARE COUNTS THE SAME?
JSP T,NOSAME ;NO
MOVE T,TAC ;REMEMBER WORD COUNT
MOVE N,2(NA) ;SET UP POINTERS TO THE VALUE CHAINS
MOVE PN,2(FS)
LCOMP1: MOVE TAC,3(N) ;COMPARE VALUE WORDS...
CAME TAC,3(PN)
JSP T,NOSAME ;DIFFERENT
MOVE TAC,4(N) ;COMPARE FLAGS...
CAME TAC,4(PN)
JSP T,NOSAME ;DIFFERENT
SKIPN (N)
SKIPE (PN)
JRST NOSAM1 ;UNDEFINED.
SKIPN 2(N)
SKIPE 2(PN)
JRST NOSAM1 ;UNDEFINED.
MOVE N,1(N) ;ADVANCE VALUE POINTERS TO NEXT
MOVE PN,1(PN) ; VALUE CELLS
SOJG T,LCOMP1 ;JUMP UNLESS DONE.
;HERE THE TWO LITERALS ARE THE SAME, AND WE FLUSH ONE OF THEM
SAME: SKIPN PN,3(FS) ;GET FIXUPS FOR THIS ONE. -ELIMINATE CAR(FS)
JRST NOTN1 ;NONE.
MOVE T,3(NA) ;GET FIXUPS FOR OTHER
MOVEM PN,3(NA) ;STORE OTHER-FIXUPS IN THIS ONE
JUMPE T,NOTN1 ;IF THERE ARE NO "THIS-FIXUPS", WE'RE DONE
LOOP2: SKIPN N,1(PN) ;SEEK END OF THE OTHER-LIST
JRST EFND ;FOUND IT.
MOVE PN,N ;LINK ON
JRST LOOP2
EFND: MOVEM T,1(PN) ;HEAD OF THIS-LIST INTO TAIL OF OTHER-LIST
NOTN1: SKIPN PN,4(FS) ;SAME AS ABOVE FOR POLFIXES.
JRST NOTN2 ;NONE.
MOVE T,4(NA)
MOVEM PN,4(NA)
JUMPE T,NOTN2
LPQ2: SKIPN N,1(PN) ;SEEK END OF THE OTHER-LIST
JRST Q2FND ;FOUND IT.
MOVE PN,N ;LINK ON
JRST LPQ2
Q2FND: MOVEM T,1(PN) ;HEAD OF THIS-LIST INTO TAIL OF OTHER-LIST
NOTN2: HLRZ PN,2(FS) ;SAME AS ABOVE FOR LABELS
JUMPE PN,NOTN3 ;NONE.
HLRZ T,2(NA)
HRLM PN,2(NA)
JUMPE T,NOTN3
LPQ3: SKIPN N,1(PN) ;SEEK END OF THE OTHER-LIST
JRST Q3FND ;FOUND IT.
MOVE PN,N ;LINK ON
JRST LPQ3
Q3FND: MOVEM T,1(PN) ;HEAD OF THIS-LIST INTO TAIL OF OTHER-LIST
NOTN3: MOVE N,FS ;REMEMBER ADDRESS OF CAR(FS)
MOVE FS,1(FS) ;FS_CDR(FS)
MOVE T,FSTPNT
MOVEM T,1(N) ;POINT LITERAL HEADER AT FS.
HRRZ T,2(N) ;GET POINTER TO VALUE LIST
MOVEM T,FSTPNT ;ADD VALUE-LIST TO FS.
LOOP4: SKIPN TAC,1(T) ;SEEK END OF VALUE-LIST
JRST VFND ;END FOUND
MOVE T,TAC
JRST LOOP4
VFND: MOVEM N,1(T) ;STORE LITERAL-HEADER AT END OF LIST
POPJ P, ;NA CONTAINS POINTER TO SMALLEST.
; VAR AND %VAR
^%VAR: MOVE N,OPCNT+1 ;VAR PSEUDO-OP
TLNE N,INCF
JRST PSLIT
PUSH P,[SPCFN] ;SET RETURN ADDRESS. FALL INTO VAR
^VAR: PUSHJ P,BFRC ;FORCE OUT BINARY
MOVE NA,PCNT+1 ;GET READY
LOOP.1: SKIPN TAC,VARLST
POPJ P, ;NONE THERE
MOVE PN,FSTPNT ;PUT BACK ON FREE STORAGE
EXCH PN,1(TAC)
MOVEM PN,VARLST ;KEEP VARLST UP TO DATE
MOVEM TAC,FSTPNT
MOVE PN,(TAC) ;SYMBOL NAME
AOS N,2(TAC) ;NUMBER OF WORDS NEEDED
;(WAS STORED AS ONE TOO SMALL)
ADDM N,OPCNT
EXCH N,PCNT
ADDM N,PCNT
PUSHJ P,LVDEF ;DEFINE VARIABLE HERE (N = LOCATION)
MOVE N,OPCNT
CAMGE N,BRK
JRST LOOP.2
CAML N,HICNT
MOVEM N,HICNT
JRST LOOP.1
LOOP.2: CAML N,@CURBRK
MOVEM N,@CURBRK
JRST LOOP.1
BEND
BEGIN ORG SUBTTL ORG, LOC, RELOC, USE, AND SET
^%ORG: MOVE NA,OPCNT+1
TLNE NA,INCF
JRST PSLIT
MOVEM N,SV ;SAVE VALUE
PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS
TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TLNE UNDF ;DEFINED?
JRST OERR ;NO
TLNE ESPF ;SPC. CHR?
JRST SCR ;YES
MOVE T,[XWD PCNT,PCSAV]
BLT T,PCSAV+3 ;SAVE OLD LOC.
SKIPN SV ;IS IT LOC?
MOVEI NA, ;YES
SKIPGE SV ;IS IT RELOC?
MOVEI NA,1 ;YES
ORG2: ANDI N,777777 ;LEAVE US NOT GET CONFUSED
XOR NA,PCNT+1 ;SET
TRNE NA,1 ;CHANGING RELOCATION?
JRST ORG4
ORG5: SUB N,PCNT
ADDM N,PCNT
ADDB N,OPCNT
ORG3: MOVEI T,(N)
ORG3A: MOVE NA,OPCNT+1
TRNN NA,1
SKIPA NA,[ABSCNT]
MOVEI NA,LOCNT
MOVEM NA,CURBRK
CAMGE T,BRK ;HIGH SEG?
JRST .+5 ;NO,LOW
CAMGE T,HICNT ;YES,IS OPCNT HICNT
JRST .+5 ;NO
MOVEM T,HICNT ;YES, INCREMENT HIGH
JRST .+3
CAML T,@CURBRK ;IS OPCNT LOCNT?
MOVEM T,@CURBRK ;YES, INCREMENT LOW
TLNE ESPF
JRST NSPCFN
JRST SPCFN
ORG4: XORB NA,PCNT+1 ;STORE RELOC, GET BACK ORIGINAL VALUE
MOVEM NA,DPCNT+1;AND STORE HERE ALSO
XOR NA,OPCNT+1 ;TEST THIS ONE
XORM NA,OPCNT+1 ;AND STORE IT
TRNE NA,1
JRST ORG5
;SORRY, PCNT AND OPCNT HAVE DIFFERENT RELOCATION
ERROR[ASCIZ/INDETERMINATE PHASE DUE TO RELOC, WILL DEPHASE/]
MOVE NA,PCNT+1
MOVEM NA,OPCNT+1
MOVEM N,PCNT
MOVEM N,OPCNT
JRST ORG3
SCR: MOVE T,[XWD PCNT,PCSAV+4] ;SWAP (EXCHANGE) PCNT WITH PCSAV
MOVE O,[XWD PCSAV,PCNT]
MOVE NA,[XWD PCSAV+4,PCSAV]
BLT T,PCSAV+7
BLT O,PCNT+3
BLT NA,PCSAV+3
MOVE NA,PCNT+1
MOVEM NA,DPCNT+1
HRRZ T,OPCNT
JRST ORG3A
SV: 0
PCSAV: BLOCK 10
OERR: ERROR[ASCIZ/UNDEFINED FIELD -- ORG/]
JRST SPCFN
BEGIN USE
^^%USE: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
PUSHJ P,BFFRC ;FORCE OUT BINARY AND FIXUPS
TLNE B,SPCLF ;SPCL CHR NEXT?
JRST SPCL ;YES
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG ;IDENT?
JRST ERR ;NO
MOVE N,CURNT ;GET CURRENT POINTER
MOVSI O,PCNT
HRRI O,2(N) ;RESET...
BLT O,4(N) ;...
MOVE O,OPCNT+1 ;CURRENT...
HRLM O,3(N) ;ONE...
SKIPN N,NULN+1 ;GET CHAIN POINTER
JRST NON
LOOP1: CAMN L,(N) ;THIS ONE?
JRST FND ;YES
SKIPE N,1(N) ;NO, GET NEXT, ANY?
JRST LOOP1
NON: GFST NA,FSTPNT ;GET FREE STRG
MOVE N,NULN+1 ;GET POINTER
EXCH N,1(NA) ;INSERT NEW ONE
MOVEM N,FSTPNT
MOVEM NA,NULN+1
MOVEM L,(NA) ;DEPOSIT SIXBIT
MOVEM NA,CURNT ;THIS ONE NOW CURRENT
JRST SPCFN
SPCL: MOVE N,CURNT ;GET CURRENT
MOVSI O,PCNT ;AND RESET
HRRI O,2(N)
BLT O,4(N)
MOVE O,OPCNT+1
HRLM O,3(N)
MOVEI N,NULN
FND: MOVSI O,2(N) ;GET SOURCE
HRRI O,PCNT ;GET DEST.
MOVEM N,CURNT ;THIS ONE NOW CURRENT
BLT O,PCNT+2 ;BLT IN...
HLR O,PCNT+1 ;...
HRRZM O,OPCNT+1 ;;;
TRNN O,1
SKIPA O,[ABSCNT]
MOVEI O,LOCNT
MOVEM O,CURBRK
HRRZS PCNT+1 ;...
MOVE O,PCNT+1
MOVEM O,DPCNT+1
JRST SPCFN
^NULN: BLOCK 5
^CURNT: 0
^SNULN: 0
0
0
1(1)
0
NULN
ERR: ERROR[ASCIZ/ILL. FORMAT -- USE/]
JRST SPCFN ;RETURN
BEND
^NULN_NULN
^SNULN_SNULN
BEGIN SET
^^%SET: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
TLNE B,SPCLF ;SPC CHR NEXT
JRST SPCL ;YES ITS FOR NULL
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG ;IDENT?
JRST ERR ;NO
SKIPN N,NULN+1 ;GET LIST, ANY?
JRST NON ;NO
LOOP1: CAMN L,(N) ;THIS ONE?
JRST FND ;YES
SKIPE N,1(N)
JRST LOOP1
NON: GFST N,FSTPNT ;GET FREE STRG
MOVE NA,NULN+1
EXCH NA,1(N) ;PUT ON LIST
MOVEM NA,FSTPNT
MOVEM N,NULN+1
MOVEM L,(N) ;DEPOSIT SIXBIT
FND: PUSH P,N
TRNE B,COMF ;,?
PUSHJ P,SCAN ;YES, SKIP
TDO [XWD OPFLG,NOFXF]
PUSHJ P,MEVAL ;EVALUATE EXPRESSION
POP P,T ;GET POINTER
TLNE UNDF!ESPF ;DEFINED?
JRST ERR ;NO
CAMN T,CURNT ;CURRENT ONE?
JRST ORG2 ;YES
HRRZM N,2(T) ;DEPOSIT VALUE...
HRRZM N,4(T) ;...
MOVEM NA,3(T) ;DEPOSIT RELOC
HRLM NA,3(T) ;...
JRST SPCFN
SPCL: MOVEI N,NULN
JRST FND
ERR: ERROR[ASCIZ/ILL. FORMAT -- SET/]
JRST SPCFN
BEND
BEND
BEGIN MAC SUBTTL MACROS, FOR, REPEAT, IF'S ;DEFINE
DERR1: ERROR [ASCIZ/NOT IDENT AFTER DEFINE/]
JRST SPCFN
^%DEF: SKIPA FS,BLOCK ;USE CURRENT BLOCK FOR NORMAL DEFINE
^%GDEF: MOVEI FS,1 ;USE OUTER BLOCK FOR GDEFINE
HRRZM FS,GDEFBK# ;SAVE BLOCK NUMBER
PUSHJ P,SCAN ;GET NAME OF MACRO
TLNN IFLG ;IDENT?
JRST DERR1 ;NO
DEF0: MOVE T,L ;GET SIXBIT
IDIVI T,HASH ;HASH
MOVMS FS
MOVEI T,MACRT-1(FS) ;T=OLD POINTER
DEF1: SKIPN O,1(T) ;LOOK FOR PREVIOUS DEFINITION OF THIS MACRO
JRST DEF2 ;NONE THERE.
CAMN L,(O)
JRST REDEF
SKIPN T,1(O) ;NOW, O = OLD POINTER
JRST DEF2 ;NONE THERE.
CAME L,(T)
JRST DEF1 ;NOW, T = OLD POINTER AGAIN
REDEFX: EXCH T,O ;SHUFFLE AC'S. O _ CURRENT BLOCK, T _ PREVIOUS
REDEF: HRRZ N,2(O) ;GET BLOCK BITS OF OLD DEFINITION
CAME N,GDEFBK ;SAME AS THIS BLOCK (REDEFINTION)?
JRST REDEF1 ;NOT AN ORDINARY REDEFINITION.
PUSHJ P,REDEF0
JRST DEF3
REDEF0: PUSH P,B ;REDEFINITION - FLUSH OLD TEXT & RE-USE SYM BLK
PUSH P,C
MOVE C,4(O)
HLRZ B,(C)
ADDI B,(C)
PUSHJ P,MACRET
POP P,C
POP P,B
POPJ P,
REDEF1: JUMPE N,DEF2 ;JUMP IF REDEFINING A PREDFINED MACRO. INSERT NEW.
MOVE N,GDEFBK ;GET BLOCK FOR THIS DEFINITION
CAIE N,1 ;IS THIS A GLOBAL DEFINITION?
JRST DEF2 ;NO, JUST A NEW, LOCAL DEFINITION. INSERT NEW.
HRRZ N,2(O)
CAME N,BLOCK ;SKIP IF OLD DEFINITION IS IN CURRENT BLOCK
ERROR [ASCIZ/NON-LOCAL MACRO REDEFINED BY INNER BLOCK GDEFINE/]
PUSHJ P,REDEF0 ;FLUSH OLD DEFINITION.
MOVE N,FSTPNT ;GIVE BACK TO FREE STORAGE AND DELINK
EXCH N,1(O) ;GET LINK OUT OF THIS BLOCK
MOVEM N,1(T) ;STORE IN PREVIOUS BLOCK (DELINKS)
MOVEM O,FSTPNT
JRST DEF0 ;FLUSH ANY OTHER INTERMEDIATE-LEVEL DEFINITIONS.
DEF2: GFST O,FSTPNT ;GET FREE STORAGE. INSERT DEFINITION.
MOVEI T,MACRT-1(FS) ;GET CHAIN ADDRESS
DEF2A: SKIPE N,1(T) ;END OF THE CHAIN?
SKIPN 2(N) ;NO. SKIP UNLESS PREDEFINED MACRO.
JRST DEF2B ;INSERT AFTER (T)
HRRZ FS,2(N)
CAMG FS,GDEFBK ;SKIP IF THIS BLOCK IS TOO DEEPLY NESTED FOR US.
JRST DEF2B ;INSERT AFTER (T)
MOVEI T,(N)
JRST DEF2A
DEF2B: MOVE N,1(T) ;GET LINK OUT
EXCH N,1(O) ;STORE LINK OUT INTO NEW BLOCK
MOVEM N,FSTPNT ;STEAL BLOCK (O) FROM FSTPNT
MOVEM O,1(T) ;STORE NEW LINK OUT (INSERTS O AFTER T)
MOVEM L,(O) ;DEPOSIT SIXBIT
MOVE N,GDEFBK ;GET BLOCK BITS.
MOVEM N,2(O) ;DEPOSIT BLOCK BIT
DEF3: SKIPE XCRFSW ;CREF?
CREF6 6,(O) ;YES
MOVE FS,MTBPNT ;GET POINTER TO FREE MACRO AREA
MOVEM FS,4(O) ;DEPOSIT POINTER
MOVEI T, ;ZERO ARG COUNT
TDNE B,[CRFG,,LBCF] ;CR OR { NEXT?
JRST NOCAT ;YES, NO CONCAT
TRNE B,LFPF ;(NEXT?
JRST NOCAT ;YES, NO CONCAT
TRNN B,RBCF ;} ?
JRST DEF3A ;NO. IT'S A LEGAL CONCATENATION CHR.
ERROR [ASCIZ/ILLEGAL CONCATENATION CHR/]
JRST NOCAT
;DEFINE CONTINUED. STORE CONCATENATION CHR. GET ARGS, MACRO BODY.
DEF3A: PUSH P,C ;SAVE CONCAT CHR.
TLZA SFL ;SKIP CONCAT CHR. SKIP ONE INSTRUCTION TOO.
NOCAT: PUSH P,[200] ;NO CONCAT CHR.
PUSHJ P,SCAN ;GET TO THE (
TLNN SCFL ;SPC. CHR?
JRST .-2 ;NO
TRNN N,LFPF!LBCF ;( OR { ?
JRST .-4 ;NO
TRNE N,LBCF ;{ ?
JRST NOARG ;YES, NO ARGS
TRNE B,RTPF ;) NEXT?
JRST AEND ;YES
ALOP: PUSHJ P,SCAN ;GET ARG
TLNN IFLG ;IDENT?
ERROR [ASCIZ/ARGUMENT NOT IDENT/]
LEG MOVEM L,(FS) ;DEPOSIT ARG
ADDI FS,1 ;INCREMNT STRG PNTR.
CLOP: TRNN B,COMF ;, NEXT?
JRST .+3 ;NO
TLZ SFL ;YES, SKIP THE ,
AOJA T,ALOP
TRNE B,RTPF ;) NEXT?
AOJA T,AEND ;YES
PUSHJ P,SCAN ;GET NEXT
JRST CLOP
AEND: PUSHJ P,SCAN ;GET TO THE {
TLNN SCFL ;SPC CHR?
JRST .-2 ;NO
TRNN N,LBCF ;{ ?
JRST .-4 ;NO
NOARG: POP P,NA ;GET CONCAT CHR.
CAIN NA,200 ;ANY?
JRST NOCTA ;NO
PUSH P,CTAB(NA) ;SAVE OLD BITS
MOVSI N,SPCLF!SPFL ;GET NEW BITS
MOVEM N,CTAB(NA) ;DEPOSIT
NOCTA: PUSH P,NA ;SAVE CHR
MOVE N,FS ;POINT TO PLACE TEXT...
HRLI N,700 ;SHOULD GO
MOVE NA,MTBPNT ;ARG POINTER
PUSHJ P,TXTIN ;GET TEXT IN
MOVEI L,177
LEG IDPB L,N ;DEPOSIT END...
MOVEI L,3 ;OF MACRO...
LEG IDPB L,N ;INDICATION
MOVEM T,3(O) ;DEPOSIT ARG COUNT
MOVEM O,(FS) ;DEPOSIT REVERSE POINTER
MOVEI L,1(N) ;GET END
SUB L,FS ;FORM LENGTH
HRLM L,(FS) ;DEPOSIT
JUMPE T,BNOA ;NO ARGS?
MOVS TAC,FS ;PREPARE TO MOVE UP
HRR TAC,MTBPNT ;...
SUBI N,(T)
BLT TAC,(N)
BNOA: ADDI N,1
HRRZM N,MTBPNT ;ADVANCE POINTER
POP P,N ;GET CONCAT CHR.
CAIE N,200 ;NO CONCAT?
POP P,CTAB(N) ;RESTORE BITS
JRST SPCFN
;TXTIN: CALL, TO READ TEXT INTO CORE, WITH PLACE IT IS TO GO
;IN N, ARG POINTER IN NA, ARG COUNT IT T, CONCAT
;CHR. ON TOP OF STACK. USES PN,TAC,L
^TXTIN: SETZM BCNT ;INIT { } COUNT
;IN CASE OF ACCIDENTS, WE REMEMBER SOME THINGS HERE
SKIPN PN,TLBLK
HRRO PN,INLINE
MOVEM PN,TXTIL
MOVE PN,PGNM
MOVEM PN,TXTIPG
NOTNX,< MOVE PN,[FILNM,,TXTIFL]
BLT PN,TXTIFL+4 >;NOTNX
TNX,<
MOVE PN,JFNTBL
MOVEM PN,TXTIFL ;SAVE INPUT JFN
>;TNX
JRST NLOOP
NLOOP1: LEG IDPB C,N
NLOOP: PUSHJ P,SCAN1 ;GET CHR.
JUMPGE B,SPCCHR ;SPC. CHR?
TLNE B,NMFLG ;NUM?
JRST SNUMS ;YES
MOVEM N,NSTO
LEG IDPB C,N
MOVEI PN,(B) ;GET SIXBIT
ILOOP: PUSHJ P,SCAN1 ;GET CHR.
JUMPGE B,ISPC ;SPC CHR?
LEG IDPB C,N ;NO, DEPOSIT
TLNE PN,770000 ;6 CHRS?
JRST ILOOP ;YES
LSH PN,6
ORI PN,(B) ;INSERT
JRST ILOOP
ISPC: JUMPE T,SPCCHR ;NO ARGS?
MOVE TAC,T ;GET COUNT
MOVE L,NA ;GET POINTER
ALOOP: CAMN PN,(L) ;IS THIS IDENT WE SCANNED AN ARG?
JRST YUP ;YUP
ADDI L,1
SOJG TAC,ALOOP ;LOOP MATCHING THIS ID TO ANY FORMAL ARG
SPCCHR: CAMN C,-1(P) ;CONCAT CHR?
JRST NLOOP ;YES
TRNE B,LBCF ;{ ?
AOS BCNT ;YES, COUNT
TRNE B,RBCF ;} ?
SOSL BCNT ;YES,COUNT
JRST NLOOP1 ;RETURN
SETZM TXTIPG
POPJ P, ;RETURN
YUP: MOVEI PN,177 ;DEPOSIT ARG POINTER...
MOVE N,NSTO ;GET POINTER
LEG IDPB PN,N ;...
MOVEI PN,1 ;...
LEG IDPB PN,N ;...
MOVE L,T ;FORM ARG NUMBER...
SUB L,TAC ;...
LEG IDPB L,N ;AND DEPOSIT
JRST SPCCHR
SNUMS: LEG IDPB C,N ;DEPOSIT
PUSHJ P,SCAN1 ;GET CHR.
JUMPL B,SNUMS ;NOT SPC CHR?
JRST SPCCHR ;SPCCHR
NSTO: 0
BCNT: 0
BEGIN ARGIN
;ARGIN: CALL TO READ IN ARGS. USES NEXT FREE SPACES
; IN CONTIGUOUS AREA. USES N,PN,TAC,NA
; # OF ARGS SHOULD BE IN N
^^ARGIN:
HRRZ NA,MTBPNT ;GET FREE AREA
PUSH P,NA ;SAVE ON PDL (RECURSIVE)
ADD NA,N ;ADD # OF ARGS
HRLI NA,440700 ;MAKE INTO POINTER
PUSHJ P,SCAN1 ;GET NEXT CHR.
TRNN B,LFPF ;(?
JRST CRMOD ;NO - ARGUMENT LIST IS NOT IN PARENS
LOOP2: PUSHJ P,SCAN1 ;YES,PASS IT
LEG MOVEM NA,@(P) ;DEPOSIT POINTER TO FIRST ARG
TRNE B,BSLF ;BACKSLASH? \ ()?
PUSHJ P,BKHAN ;YES. HANDLE IT. (ALWAYS SKIPS!)
PUSHJ P,SARGIN ;GET ARG
TRNN B,RBCF ;}?
TLNN B,CRFG!RBRF ;DID IT STOP ON CR?
JRST .+3 ;NO
PUSHJ P,SARCON ;YES, CONTINUE
JRST .-3
MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,2 ;OF ARG...
LEG IDPB TAC,NA ;INDICATION
ADDI NA,1
HRLI NA,440700 ;NEXT AREA
LOOP1: TRNE B,COMF ;,?
JRST GNXT1 ;YES
TRNE B,RTPF ;)?
JRST GTERM1 ;YES
PUSHJ P,SCAN1 ;NO, IT MUST BE }
JRST LOOP1
GNXT1: SOJLE N,GALL1 ;NO MORE ALLOWED?
AOS (P) ;YES, MORE , ADVANCE POINTER
JRST LOOP2
CRMOD: ;ARGUMENTS NOT IN PARENS
LEG MOVEM NA,@(P) ;DEPOSIT POINTER
TRNE B,BSLF ;BACKSLASH \ ()?
PUSHJ P,BKHAN ;YES. HANDLE IT. (ALWAYS SKIPS!)
PUSHJ P,SARGIN ;GET ARG
TRNN B,RTPF ;)?
JRST .+3 ;NO
PUSHJ P,SARCON ;YES, CONTINUE
JRST .-3
MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,2 ;OF ARG...
LEG IDPB TAC,NA ;INDICATION
ADDI NA,1
HRLI NA,440700
LOOP3: TRNE B,COMF ;,?
JRST GNXT2 ;YES
TLNE B,CRFG!RBRF ;CR?
JRST GTERM2 ;YES
PUSHJ P,SCAN1 ;MUST BE }
JRST LOOP3
GNXT2: SOJLE N,GALL2 ;NO MORE ALLOWED?
AOS (P) ;YES, MORE
PUSHJ P,SCAN1
JRST CRMOD
GTERM1: SETZB B,C ;PASS THE ) (RETURNING NOTHING)
GTERM2: SOJLE N,GL ;GOTTEM ALL
MOVEI TAC,177 ;NO, DEPOSIT
LEG IDPB TAC,NA ;A NULL...
MOVEI TAC,2 ;ARG...
LEG IDPB TAC,NA ;...
HRLI NA,440700
LOOP4: AOS (P) ;INCREMNT POINTER
LEG MOVEM NA,@(P) ;DEPOSIT
SOJG N,LOOP4
ADDI NA,1
GL: SUB P,[1,,1] ;FLUSH PNTR FROM PDL
POPJ P,
;HERE WHEN WE HAVE ALL THE ARGS WE NEED.
GALL1: PUSHJ P,SCAN1 ;GET CHR. (ARGS ARE IN PARENS. SCAN TO CLOSE PAREN)
TRNN B,RTPF ;)?
JRST GALL1 ;NO
GALL2: SUB P,[1,,1] ;FLUSH PNTR.
JRST SCAN1 ;EAT THE ) OR , AND RETURN
; HANDLE BACKSLASH ARGUMENTS
;WARNING! This code knows everything about it's environment all the way back
;to what the caller of ARGIN pushed on the stack. Modifiers beware!!
BKHAN: ANDI NA,-1 ;RIGHT SIDE ONLY
MOVEM NA,MTBPNT ;UPDATE IN CASE MEVAL NEEDS IT FOR MACRO HACKING
MOVEI TAC,1(P) ;SOURCE=0, DESTINATION = PDL
BLT TAC,7(P) ;SAVE AC'S (0-6)
ADD P,[7,,7] ;ADJUST STACK
TRO NOFXF ;NO FIXUPS FROM MEVAL
PUSHJ P,MEVAL ;GET VALUE
TLNN UNDF!ESPF
TRNE NA,17
TDZA N,N ;UNDEFINED. SET VALUE TO ZERO AND SKIP TO LOSE MSG
JRST .+2 ;VALUE IS OK. AVOID LOSE MESSAGE
ERROR [ASCIZ /UNDEFINED \ ARGUMENT/]
EXCH N,B ;SAVE NUMBER IN B, CHARACTER FLAGS IN N
EXCH C,NA-6(P) ;EXCHANGE CHAR WITH OLD MTBPNT POINTER.
HRRZS MTBPNT ;MAKE SURE MTBPNT IS RIGHT SIDE ONLY
BKHAN0: CAME C,MTBPNT ;HAVE WE BEEN SCREWED BY MEVAL?
JRST BKHAN1 ;YES. NOW LETS GO FIX IT.
HRLI C,440700 ;MAKE ARG PNTR UP TO DATE
MOVEM C,@-7-1(P) ;MAKE SURE ARG PNTR IS UP TO DATE
PUSHJ P,BKSLSH ;CON TO ASCII
MOVE B,N ;CHARACTER FLAGS GO BACK TO B
EXCH C,NA-6(P) ;RESTORE CHAR, PUT BACK NEW PNTR
SUB P,[7,,7]
MOVSI TAC,2(P)
HRRI TAC,1
BLT TAC,6 ;RESTORE AC'S
MOVE TAC,1(P)
TDZ REFLAG
AND TAC,REFLAG
OR TAC ;RESTORE FLAGS
TLZ SFL ;SKIP THE , OR ) OR WHATEVER
AOS (P) ;ALWAYS SKIP RETURN
POPJ P,
;THE FOLLOWING KLUDGE FIXES A HORRIBLE BUG IN STORAGE MANAGEMENT
;C CONTAINS FIRST LOC TO NOT MOVE.
BKHSVC: 0
BKHSVN: 0
BKHSVB: 0
;I ADDED THIS CODE TO NOTICE IF FREE STORAGE GOT USED BY CALL TO MEVAL
;IF SO, WE HAVE TO MOVE THE ARGUMENTS ACCUMULATED BY ARGIN - REG
BKHAN1: MOVEM N,BKHSVN
MOVEM C,BKHSVC ;SAVE TOP ADDRESS FOR MACRET
HRRZS NA,-12(P) ;MAKE CERTAIN THAT THIS IS RIGHT SIDE ONLY!
MOVEM NA,BKHSVB ;SAVE BOTTOM FOR MACRET
HRLZ NA,-12(P) ;SOURCE = CALLER'S OLD MTBPNT
HRR NA,MTBPNT ;DESTINATION = CURRENT MTBPNT
ADD C,MTBPNT
SUB C,-12(P) ;THIS IS THE ENDING ADDRESS OF BLT
LEG SETZM -1(C)
BLT NA,-1(C) ;MOVE ARGUMENT LIST TO A NEW HOME
;C= FIRST FREE LOCATION.
HRRZ NA,MTBPNT
SUB NA,-12(P) ;CALC OFFSET
ADDM NA,-12(P) ;FIX CALLER'S MTBPNT
ADDM NA,-10(P) ;FIX ARGUMENT POINTER
HRRZ N,-10(P) ;GET ARGUMENT POINTER
ADDM NA,(N) ;FIX ONE ARGUMENT
CAMLE N,MTBPNT ;DONE FIRST ARG YET?
SOJA N,.-2 ;NO. LOOP
HRRZM C,MTBPNT ;SET NEW MTBPNT
EXCH C,BKHSVC ;GET TOP ADDRESS OF BLOCK
PUSH P,B
MOVE B,BKHSVB
EXCH C,B ;LOW ADDRESS IN C, HIGH ADDRESS IN B
PUSHJ P,MACRET
POP P,B
MOVE C,BKHSVC ;GET NEW OLD MTBPNT
MOVE N,BKHSVN ;RESTORE CHARACTER FLAGS TO N
JRST BKHAN0 ;RETURN. C SETUP. CHECK AGAIN BECAUSE
;SOMETIMES MACRET SCREWS UP MTBPNT!
BEND ARGIN
;SARGIN: CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR
;DEPOSIT SHOULD BE IN NA.
; STARTS WITH CURRENT CHR. & TERMINATES ON , OR CR OR ) OR > OR ].
; USES TAC . IF FIRST IS { , TERMS ON }
^SARGIN:PUSH P,TAC
SKIPN TAC,TLBLK
HRRO TAC,INLINE
MOVEM TAC,SARLN ;SAVE FOR FATAL EOF TYPEOUT
MOVEM TAC,SARLIN
MOVE TAC,PGNM
MOVEM TAC,SARGPG
MOVEM TAC,SARPG
NOTNX,< MOVE TAC,[FILNM,,SARFIL]
BLT TAC,SARFIL+4 >;NOTNX
TNX,<
MOVE TAC,JFNTBL
MOVEM TAC,SARFIL ;SAVE INPUT JFN
>;TNX
POP P,TAC
SETZM TABMFG# ;SET AFTER WE'VE SEEN CRUD
TRNE B,LBCF ;{ ?
JRST BROK ;YES
SKIPE TABMSW ;NEW TAB IN ARGUMENT HACK?
JRST RLOOP1 ;YES. WE HAVE TO WORK HARDER
SLOOP: TRZ B,RBCF
TDNE B,[XWD RBRF!CRFG,RTPF!COMF] ;, OR CR OR ) OR > OR ]?
JRST BFND ;YES
SARCO: LEG IDPB C,NA ;NO, DEPOSIT
PUSHJ P,SCAN1 ;GET NEXT
JRST SLOOP
RLOOP3: LEG IDPB C,NA ;NO, DEPOSIT
TLNN B,SPFL ;SPACE OR TAB?
MOVEM NA,TABMFG ;NO. REMEMBER LAST SIGNIFICANT CHR
RLOOP4: PUSHJ P,SCAN1 ;GET NEXT
RLOOP1: SKIPN TABMFG ;SEEN ANYTHING YET?
TLNN B,SPFL ;NO. BLANK OR TAB?
TRZA B,RBCF ;SEEN SOMETHING, OR NOT BLANK
JRST RLOOP4 ;IGNORE LEADING BLANKS
TDNN B,[XWD RBRF!CRFG,RTPF!COMF] ;, OR CR OR ) OR > OR ]?
JRST RLOOP3 ;NO. CONTINUE
SKIPE TABMFG
EXCH NA,TABMFG ;LOAD NA FROM TABMFG
SETZM SARGPG
POPJ P,
BROK: SETZM SARTAC ;HERE WHEN FIRST CHARACTER OF ARG IS {
JRST BLOOP
BLOOP1: LEG IDPB C,NA ;DEPOSIT CHR.
BLOOP: PUSHJ P,SCAN1 ;GET CHR.
TRNE B,LBCF ;{ ?
AOS SARTAC ;YES
TRNE B,RBCF ;} ?
SOSL SARTAC ;YES
JRST BLOOP1 ;NOT AT THE END YET
TLZ B,RBRF ;CLEAR END OF LINE
BFND: SETZM SARGPG
POPJ P,
SARTAC: 0
SARLIN: 0
SARPG: 0
^SARCON:PUSH P,SARLIN
POP P,SARLN
PUSH P,SARPG
POP P,SARGPG
SKIPN TABMSW ;SPECIAL TAB HANDLING?
JRST SARCO ;NO.
SKIPE TABMFG ;WAS THERE AN OLD NA STORE HERE AT EXIT?
EXCH NA,TABMFG ;YES. WELL, PUT IT BACK!
JRST RLOOP3 ;YES. PICKUP IN THE RIGHT LOOP
;ROUTINE TO RETURN MACRO TABLE SPACE
;CALLED WITH B: (HIGHEST ADDRESS OF THIS BLOCK)+1
; C: LOWEST ADDRESS OF THIS BLOCK
^MACRET:CAME B,MTBPNT ;IS THIS JUST BELOW MTBPNT?
JRST MACR2 ;NO SUCH LUCK.
MOVEM C,MTBPNT ;YES. JUST BACK UP MTBPNT TO INCLUDE THIS
CAME C,LGARB ;DOES THIS ABUT GARBAGE AREA?
POPJ P, ;NOPE. ALL DONE NOW.
MOVE B,GARBAG ;ABUTS GARBAGE AREA: BACK UP MTBPNT SOME MORE
MOVE C,2(B) ;GET LOW ADDRESS OF THIS BLOCK
MOVEM C,MTBPNT ;IS NEW MTBPNT
MOVE C,FSTPNT ;RETURN GARBAGE PNTR (REMOVE FROM GARBAGE,
EXCH C,1(B) ;ADD TO FSTPNT
MOVEM C,GARBAG
MOVEM B,FSTPNT
JUMPE C,.+2 ;SO, IS THERE ANY GARBAGE LEFT?
MOVE C,3(C) ;YES. GET HIGH ADDRESS IN GARBAGE
MOVEM C,LGARB ;SET UP NEW "LAST GARBAGE" PNTR
POPJ P,
;NOT AT END - INSERT IN ORDERED LIST, COMBINING WITH OLD ENTRIES IF POSSIBLE
MACR2: PUSH M,T
PUSH M,N
MACR2A: SKIPA N,[-1,,GARBAG-1]
MACR3: MOVEI N,(T)
SKIPN T,1(N) ;ANYTHING LEFT ON THE LIST?
JRST MACRE ;NO. WE RAN OFF THE END
CAMG B,3(T) ;ARE WE ABOVE THE NEXT GUY?
JRST MACR3 ;NO. GO DOWN.
CAMN C,3(T) ;HERE WE HAVE PROPER POSITION
JRST MACRL ;LOW END OF US MATCHES HIGH END OF OLD
MACRE: JUMPL N,.+3 ;JUMP IF THIS IS HIGHEST GARBAGE
CAMN B,2(N) ;HIGH END MATCHES OLD?
JRST MACRH ;YES. SEE US COMBINE TWO BLOCKS
EXCH N,FSTPNT ;NEITHER MATCHES - CREATE NEW ENTRY
JUMPE N,MACRLZ ;JUMP IF NO FS
EXCH T,1(N) ;GOBBLE THE FS BLOCK
EXCH T,FSTPNT
MOVEM N,1(T) ;
SETZM (N) ;ZERO SIZE FOR UPCOMING "COMBINE"
JUMPGE T,.+2
MOVEM B,LGARB ;UPDATE END ADR IF HIGHEST POS
MOVEM B,3(N)
MACRH: MOVEM C,2(N)
SUBI B,(C)
ADDM B,(N)
MACRX: POP M,N
POP M,T
POPJ P,
MACRL: JUMPL N,[MOVEM B,LGARBJRST .+3] ;UPDATE LGARB, AVOID TEST IF AT END
CAMN B,2(N)
JRST MACRB ;BOTH ENDS MATCH - WE HAVE CLOSED A HOLE!
MOVEM B,3(T)
MACRL2: SUBI B,(C)
ADDM B,(T)
JRST MACRX
MACRB: MOVE C,2(T) ;COMBINE ALL 3 PIECES INTO ONE, RETURN ONE OLD PNTR BLK
MOVEM C,2(N)
EXCH N,FSTPNT
EXCH N,1(T)
EXCH T,FSTPNT
MOVEM N,1(T)
JRST MACRL2
;HERE IF NO FS FOR PNTR
N, ;ARG FOR NOFSL
MACRLZ: JSR NOFSL ;THIS MAY CHANGE LIST, SO ...
MOVEM N,FSTPNT ;PUT BACK FS
JRST MACR2A ;AND START SCAN OVER
^GARBAG:0
^LGARB: 0
^LGET: 0
PUSHJ P,SCAN1 ;GET CHR.
TRNN B,LBCF ;{ ?
JRST .-2 ;NO
JRST @LGET ;YES
;REPEAT - %REP, REP
DEFINE MACEX (AC)
< LDB AC,[POINT 6,LSTPNT,11]
HRL AC,INMCSW
PUSH M,AC
PUSH M,INPNTP
PUSH M,INPNT
MOVE AC,INPNTP
CAIN AC,INPNT
HRRZM M,INPNTP
MOVEI AC,
SKIPN NOEXP
JRST .+4
IBP LSTPNT
DPB AC,[POINT 6,LSTPNT,11]
SETZM XPNDSW
SETZM INMCSW
>
^%REP: TRO NOFXF ;GENERATE NO FIXUPS
PUSHJ P,MEVAL ;EVALUATE EXPR.
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED & NOT SPC. CHR?
JRST REPER ;NO
JUMPL N,REPER ;NEG. COUNT?
SETOM REPSW ;SET REPEAT SWITCH (PUT CR LF AT END)
PUSHJ P,REP ;GO DO
TRZ NOFXF
JRST ASSMBL ;PROCEED
PUSHJ P,SCAN1 ;GET NEXT
^REP: TRNN B,LBCF ;{ ?
JRST REP-1 ;NO
TLZ SFL
LBFN: JUMPE N,REP0 ;REPEAT 0?
CAIN N,1 ;REPEAT 1?
JRST REP1 ;YES
MOVE NA,MTBPNT ;MAKE READ-IN POINTER
HRLI NA,440700 ;...
PUSHJ P,SARGIN ;READ IN
SKIPN REPSW ;REPEAT?
JRST NOREP ;NO
MOVEI TAC,15 ;YES, INSERT CR LF
LEG IDPB TAC,NA
MOVEI TAC,12
LEG IDPB TAC,NA
NOREP: MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,4 ;OF REPEAT...
LEG IDPB TAC,NA ;...
PUSH M,AHED ;PUSH LINE NUMBET TEST
MOVSI TAC,(<SKIPA>)
MOVEM TAC,AHED ;INHIBIT...
MOVEM TAC,LOOP6 ;LINE NUMBER SKIPPING
MACEX (TAC)
HRRZI NA,1(NA) ;INCREMENT & ZERO LEFT
PUSH M,NA ;SAVE NEW MTBPNT
PUSH M,N ;SAVE COUNT
PUSH M,MTBPNT ;SAVE OLD MTBPNT (POINTS TO STRT)
MOVEM NA,MTBPNT ;RESET MTBPNT
MOVE NA,(M) ;GET POINTER
HRLI NA,440700
MOVEM NA,INPNT ;POINT TO STRT
DEFINE MACUND (ZORCHL)
< SKIPN NOEXP
SKIPN UNDLNS
ZORCHL
HRRZ TAC,LSTPNT
CAIL TAC,TLBLK
SUBI TAC,TLBLK-MBLK
HRRM TAC,LSTPNT
TRO MACUNF>
MACUND (<POPJ P,>)
POPJ P,
REP0: SKIPN TAC,TLBLK ;REPEAT 0
HRRO TAC,INLINE
MOVEM TAC,REPPG
MOVE TAC,PGNM
MOVEM TAC,REP0PG
NOTNX,< MOVE TAC,[FILNM,,REPFIL]
BLT TAC,REPFIL+4 >;NOTNX
TNX,< MOVE TAC,JFNTBL
MOVEM TAC,REPFIL ;SAVE INPUT JFN
>;TNX
PUSHJ P,SLURP ;EAT ALL THE TEXT
SETZM REP0PG
POPJ P,
REP1: SKIPN TAC,RTFLST ;GET POINTER
SETZM BROKCT ;ZERO COUNT IF AT OUTSIDE LEVEL
GFST NA,FSTPNT
HRRZM NA,RTFLST ;GET FREE STRG.
EXCH TAC,1(NA)
MOVEM TAC,FSTPNT
MOVE TAC,BROKCT ;GET COUNT
MOVEM TAC,@RTFLST ;DEPOSIT
POPJ P,
REPER: ERROR [ASCIZ/REPEAT -- ILLEGAL EXPRESSION FOR COUNT/]
JRST SPCFN
;BKSLSH: CALL, WITH BYTE POINTER IN C & NUM IN B.
; PUTS ASCII FOR NUM (IN CURRENT RADIX) AT PLACE POINTED TO BY C.
^BKSLSH:JUMPE B,BKZER ;HANDLE ZERO SPECIALLY
MOVEM C,BKPNT ;DEPOSIT BYTE POINTER
PUSH P,N ;SAVE N
MOVEI N,1 ;
XCT SRAD ;GET RADIX
MOVEM N,BKRAD ;SAVE
POP P,N ;RESTORE N
JUMPL B,BKNEG ;NEG?
NLOPN: PUSHJ P,BKCON ;DO IT
MOVE C,BKPNT ;RESTORE POINTER
POPJ P, ;LEAVE
BKNEG: MOVEI C,"-" ;GET - SIGN
LEG IDPB C,BKPNT
MOVMS B
JRST NLOPN
BKRAD: 0
BKPNT: 0
BKCON: IDIV B,BKRAD ;DIVIDE BY RADIX
JUMPE B,BZER ;ZERO?
HRLM C,(P) ;NO, SAVE REMAINDER
PUSHJ P,BKCON ;CONVERT REST OF NUM
HLRZ C,(P) ;GET REMAINDER BACK
BZER: ORI C,60 ;CON TO ASCII
LEG IDPB C,BKPNT ;PUT OUT
POPJ P, ;LEAVE
BKZER: MOVEI B,"0" ;HANDLE ZERO...
LEG IDPB B,C ;AS A SPECIAL...
POPJ P, ;CASE
; FOR STATEMENT
FER1A: ERROR [ASCIZ/NO IDENT AFTER FOR/]
JRST SPCFN
FERR2: ERROR [ASCIZ/NO IDENT FOR SECOND ARG -- FOR/]
JRST SPCFN
FERR3: ERROR [ASCIZ/NUMBER AFTER ARGS -- FOR/]
JRST SPCFN
FERR5: ERROR [ASCIZ /ILLEGAL CONCATENATION CHR -- FOR/]
JRST SPCFN
^%FOR: MOVE O,MTBPNT ;FREE STG POINTER
PUSHJ P,SCAN ;GET FIRST ARG
MOVEI FS,200 ;ASSUME NO CONCAT CHR.
TLNE IFLG ;IDENT?
JRST F1RT ;YES. THERE IS NO CONCAT. CHR.
TLNE SCFL ;LOOKING FOR CONCAT. CHR. SPC CHR?
TRNN N,ATF ;YES. IS IT @?
JRST FER1A ;NO TO EITHER OF THE ABOVE. LOSE
MOVE FS,C ;YES, GET CONCAT CHR.
TRNE B,RBCF ;IS IT A > OR A }
JRST FERR5 ;YES. ILLEGAL
TLZ SFL ;SKIP CHR.
PUSHJ P,SCAN ;GET NEXT
TLNN IFLG ;IDENT?
JRST FER1A ;NO. LOSE
F1RT: ;FS=CONCATENATION CHR, L=FIRST ARGUMENT
LEG MOVEM L,(O) ;SAVE
LEG SETZM 1(O) ;MAKE SURE THIS CELL EXISTS, (WE MAY NOT USE IT)
MOVEI T,1 ;ARG COUNT
TRNN B,COMF ;COMMA NEXT?
JRST NOSEC ;NO. THERE'S NO SECOND ARGUMENT
TLZ SFL ;SKIP THE COMMA
PUSHJ P,SCAN ;GET NEXT
TLNN IFLG ;IDENT?
JRST FERR2 ;NO
MOVEM L,1(O) ;SAVE. 1(O) IS NOT AN MPV BECAUSE WE CHECKED ABOVE.
MOVEI T,2 ;ARG COUNT
NOSEC: PUSHJ P,SCAN ;GET NEXT
TLNE IFLG ;IDENT?
JRST ICHK ;YES - CHECK FOR "IN" OR "E"
TLNN SCFL ;SPC. CHR?
JRST FERR3 ;NO. LOSE
TRNE N,LACF ;_?
JRST LFOR ;YES - ARITHMETIC FOR
TRNE N,EPSF ;EPSILON?
JRST EFOR ;YES
TRNE N,INF ;?
JRST INFOR ;YES
FERR6: ERROR [ASCIZ/UNREC IDENT OR UNREC CHR. AFTER ARGS -- FOR/]
JRST SPCFN
ICHK: CAIN L,'IN' ;IN?
JRST INFOR ;YES
CAIE L,'E' ;E?
JRST FERR6 ;NO. LOSE
JRST EFOR ;YES
; SETUP ARITHMETIC FOR
OSAV: BLOCK 2
CONSAV: 0
FSVV: 0
TSVV: 0
FERR4B: POP P,N
FERR4A: POP P,N
FERR4: ERROR [ASCIZ/UNDEFINED ARG -- FOR/]
JRST SPCFN
LFOR: MOVEM FSVV ;SAVE FLAGS
TRO NOFXF ;NO FIXUPS
MOVEM T,TSVV ;SAVE ARG COUNT
MOVEM FS,CONSAV ;SAVE CONCAT CHR.
MOVE T,(O) ;SAVE...
MOVEM T,OSAV ;ARGS
MOVE T,1(O)
MOVEM T,OSAV+1
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED?
JRST FERR4 ;NO
PUSH P,N ;SAVE
TLZ SFL
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINE?
JRST FERR4A ;NO
PUSH P,N ;SAVE
MOVEI N,1 ;ASSUME NO THIRD ARGUMENT. DEFAULT VALUE IS 1
TRNN B,COMF ;, NEXT?
JRST NOTHRD ;NO. NO THIRD ARGUMENT
TLZ SFL
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED?
JRST FERR4B ;NO
NOTHRD: MOVE T,TSVV ;GET ARG COUNT
MOVE O,FSVV ;GET OLD FLAGS
TDZ REFLAG
AND O,REFLAG
OR T ;RESTORE FLAGS
MOVE O,MTBPNT ;GET FREE STG POINTER
MOVE NA,OSAV ;REDEPOSIT ARGS
LEG MOVEM NA,(O) ;THIS IS DONE IN CASE MEVAL CHANGED MTBPNT
MOVE NA,OSAV+1
LEG MOVEM NA,1(O)
MOVE NA,(P) ;GET TERMINATION VALUE
JUMPL N,LFOR1 ;JUMP IF INCREMENT IS NEGATIVE
CAML NA,-1(P) ;ZERO TIMES?
JRST LFOR2 ;NO
JRST NOTIM ;YES
LFOR1: CAMLE NA,-1(P) ;ZERO TIMES?
JRST NOTIM ;YES
LFOR2: PUSH P,N ;SAVE N
MOVEI N,2(O) ;MAKE POINTER
HRLI N,440700 ;...
MOVE FS,CONSAV
CAIN FS,200 ;IS THERE A CONCAT CHR?
JRST FLOP1 ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI NA,SPFL!SPCLF ;GET NEW BITS
MOVEM NA,CTAB(FS)
FLOP1: PUSH P,FS ;SAVE CONCAT CHR.
MOVE NA,O ;ARG POINTER
JSR LGET ;GET TO THE {
PUSHJ P,TXTIN ;GET TEXT OF FOR-BODY.
PUSH M,AHED ;SAVE LINE NUM SKIP
MOVSI FS,(<SKIPA>)
MOVEM FS,AHED
MOVEM FS,LOOP6 ;INHIBIT LINE NUM SKIP
MACEX (FS)
EDEPO (L,N,5) ;DEPOSIT END OF FOR
HRRZI N,6(N) ;INCREMENT
PUSH M,N ;SAVE
POP P,FS ;GET CONCAT CHR
CAIE FS,200 ;ANY?
POP P,CTAB(FS) ;YES, RESTORE BITS
PUSH M,(P) ;SAVE INCREMENT
PUSH M,-1(P) ;SAVE TERM NUM
PUSH M,-2(P) ;SAVE STARTING #
PUSH M,O ;SAVE STARTING ADDRS -2
MOVEI FS,-5(N) ;GET ARG POINTER
PUSH M,FS ;SAVE
SUB P,[3(3)]
MOVEM N,MTBPNT ;RESET MTBPNT
MOVEI C,-3(N)
HRLI C,440700
LEG MOVEM C,-5(N) ;DEPOSIT ARG ...
LEG MOVEM C,-4(N) ;POINTERS
MOVE B,-2(M) ;GET NUMBER
PUSHJ P,BKSLSH ;CONVERT TO ASCII
EDEPO (TAC,C,2) ;DEPOSIT END OF ARG
ADD O,[XWD 440700,2]
MOVEM O,INPNT ;DEPOSIT
MACUND (JRST ASSMBL)
JRST ASSMBL ;GO, MAN
;ASSEMBLE THE FOR-BODY ZERO TIMES.
NOTIM: SUB P,[2(2)] ;CLEAR STACK
MOVEI N,0 ;REPEAT 0
PUSHJ P,REP
JRST ASSMBL
; SETUP "IN" FOR
INFOR: PUSHJ P,SCAN ;GET TO THE (
TLNN SCFL ;SPCL CHR?
JRST .-2 ;NO
TRNN N,LFPF ;(?
JRST .-4 ;NO
PUSHJ P,SCAN1 ;GET NEXT CHR.
MOVEI NA,5(O) ;GET POINTER FOR ARGS
HRLI NA,440700 ;...
LEG MOVEM NA,3(O) ;DEPOSIT SECOND ARG POINTER
INLOP2: TRNE B,LBCF ;{?
LEG IDPB C,NA ;YES, DEPOSIT IT
PUSHJ P,SARGIN ;GET FIRST ARG.
INLOP1: TRNE B,RTPF ;TERM BY )?
JRST RTERM ;YES
TRNE B,COMF ;TERM BY COMMA?
JRST MYCON ;YES
PUSHJ P,SARCON ;NO, CONTINUE
JRST INLOP1
MYCON:
LEG IDPB C,NA
PUSHJ P,SCAN1
TRNE B,LBCF ;{?
LEG IDPB C,NA ;YES, DEPOSIT
PUSHJ P,SARGIN
JRST INLOP1
RTERM: EDEPO (N,NA,2) ;DEPOSIT END OF ARG
CAIN FS,200 ;ANY CONCAT CHR?
JRST IFLOP ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI N,SPFL!SPCLF ;MAKE NEW BITS
MOVEM N,CTAB(FS)
IFLOP: MOVEI N,4(O) ;GET...
HRLI N,440700 ;FIRST ARG...
MOVEM N,2(O) ;POINTER
MOVEI N,1(NA) ;MAKE TEXT...
HRLI N,440700 ;POINTER
PUSH P,FS ;SAVE CONCAT CHR.
MOVE FS,N ;& SAVE
JSR LGET ;GET TO THE {
MOVE NA,O ;SET ARG POINTER
PUSHJ P,TXTIN ;GET TEXT IN
PUSH M,AHED ;SAVE LINE NUM TEST
MACEX (L)
MOVSI L,(<SKIPA>)
MOVEM L,AHED ;INIHIBIT LINE NUM...
MOVEM L,LOOP6 ;SKIPPING
EDEPO (L,N,6) ;DEPOSIT END OF FOR-IN
HRRZI N,1(N) ;FORM NEW MTBPNT
PUSH M,N ;SAVE
PUSH M,MTBPNT ;SAVE OLD
MOVEM N,MTBPNT
PUSH M,FS ;SAVE STRT OF TEXT
MOVEI N,2(O) ;GET ARG POINTER
PUSH M,N ;SAVE
POP P,FS ;GET CONCAT
CAIE FS,200 ;ANY?
POP P,CTAB(FS) ;YES, RESTORE
PUSHJ P,IFORSH ;SET UP ARGS
MACUND JRST ASSMBL
JRST ASSMBL
^IFORSH:MOVE B,(M) ;GET ARG POINTER
MOVE C,1(B) ;GET SECOND ARG POINTER
PUSH P,N ;SAVE N
MOVE B,(B) ;GET FIRST ARG POINTER
ILDB TAC,C ;GET CHR.
SKIPGE N,CTAB(TAC) ;GET BITS
JRST ILOPI2
TLNE N,SCRF ;CHECK FOR SPECIAL ({ AND < AND > AND })
XCT IFORT(N)
TRNE N,LBCF ;{?
JRST LBRK ;YES
ILOPI1: TRNE N,COMF ;,?
JRST COMTOM ;YES
TLNE N,DLETF ;DELETE?
JRST DELTOM ;YES
ILOPI2: IDPB TAC,B ;DEPOSIT
ILDB TAC,C ;GET NEXT
SKIPL N,CTAB(TAC) ;GET BITS
JRST ILOPI1
JRST ILOPI2
IFORT: FOR I_0,7 <JFCL
>
HRRI N,LBCF!TP2F ;< OR {
HRRI N,RBCF!TP2F ;> OR }
DELTOM: MOVE C,(M) ;GET ARG POINTER
MOVEM B,1(C) ;DEPOSIT SECOND ARG POINTER
EDEPO (TAC,B,2)
JRST FINIT
COMTOM: EDEPO (N,B,2)
MOVE N,(M) ;GET ARG POINTER
MOVEM C,1(N) ;DEPOSIT SECOND ARG POINTER
FINIT: POP P,N ;RESTORE
MOVE B,-1(M) ;GET START
MOVEM B,INPNT ;DEPOSIT
JRST LSTCHK
LBRK: SETZM IFOCNT ;ZERO {} COUNT
SKIPA
LILO1: IDPB TAC,B
ILDB TAC,C ;GET CHR.
SKIPGE N,CTAB(TAC) ;GET BITS
JRST LILO1 ;NOT SPC CHR.
TLNE N,SCRF
XCT IFORT(N)
TRNE N,LBCF ;{?
AOS IFOCNT ;YES
TRNE N,RBCF ;}?
SOSL IFOCNT ;YES, DONE?
JRST LILO1 ;NO
LILO2: ILDB TAC,C ;GET NEXT
SKIPGE N,CTAB(TAC) ;GET BITS
JRST LILO2
TRNE N,COMF ;,?
JRST COMTOM ;YES
TLNE N,DLETF ;DELETE?
JRST DELTOM ;YES
JRST LILO2 ;NO
IFOCNT: 0
EFOR: JSR LGET ;GET TO THE {
MOVEI NA,5(O) ;SET UP POINTER...
HRLI NA,440700 ;TO READ IN ARG...
LEG MOVEM NA,3(O) ;DEPOSIT
PUSHJ P,SARGIN ;GET ARG.
EDEPO (TAC,NA,2) ;DEPOSIT END OF ARG
MOVEI TAC,4(O) ;FORM FIRST ARG...
HRLI TAC,440700 ;POINTER
MOVEM TAC,2(O) ;DEPOSIT
JSR LGET ;GET TO THE {
MOVEI N,1(NA) ;FORM TEXT POINTER
HRLI N,440700 ;...
PUSH P,N ;SAVE
CAIN FS,200 ;ANY CONCAT CHR?
JRST EFLOP ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI NA,SPFL!SPCLF ;MAKE...
MOVEM NA,CTAB(FS) ;NEW BITS
EFLOP: PUSH P,FS ;PUSH CONCAT CHR.
MOVE NA,O ;ARG POINTER
PUSHJ P,TXTIN ;READ IN BODY OF TEXT
EDEPO (L,N,7) ;DEPOSIT END OF FOR
PUSH M,AHED ;SAVE LINE NUM SKIPPING
MACEX (L)
MOVSI L,(<SKIPA>)
MOVEM L,AHED
MOVEM L,LOOP6
POP P,L ;GET CONCAT
CAIE L,200 ;ANY?
POP P,CTAB(L) ;YES, RESTORE BITS
MOVEI N,1(N) ;FORM NEW MTBPNT
PUSH M,N ;SAVE
MOVEM N,MTBPNT ;DEPOSIT
MOVE N,2(O) ;GET FIRST ARG POINTER
IBP N
EDEPO (TAC,N,2) ;DEPOSIT END OF ARG
POP P,L ;GET START OF TEXT
PUSH M,L ;SAVE
MOVEI L,2(O) ;GET ARG POINTER
PUSH M,L ;SAVE
PUSHJ P,EFORSH ;SET UP FIRST
MACUND (JRST ASSMBL)
JRST ASSMBL
BEND MAC ;LEGTAB
LEGTAB: FOR @! X_0,LEGNUM-1{,%$L!X
}
LEGCNT__LEGNUM ;DEFINE LEGAL LOCATIONS FOR MPV
SUBTTL TENEX/IMSSS SPECIAL CODE
TNX,<
UOUTST: PUSH P,1
HRRO 1,40
PSOUT
POP P,1
POPJ P,
UOUTCH: PUSH P,1
HRRZ 1,@40
PBOUT
POP P,1
POPJ P,
NOT20,<IFE PSTISW,<
BEGIN PSTIN
PPP__14 ;LOCAL STACK POINTER
PSSLEN__20 ;LOCAL STACK SIZE
PSTACK: BLOCK PSSLEN ;LOCAL STACK
SCPOPJ: POPJ PPP,
^^PSTACS: BLOCK 20 ;STORAGE FOR FAIL ACS
;THIS FLAG IS NOT CURRENTLY USED, BUT CAN IN PRINCIPLE BE USED TO RESTORE
;ACS ON, FOR EXAMPLE, A REENTER AFTER ^C...TMW
^^PSTFLG: 0 ;NON-ZERO IF IN SIMULATION
;-1 SAYS RESTORE 17 ONLY
;0,,-1 SAYS RESTORE ALL ACS
;string input jsys (pstin) simulation - courtesy IMSSS
;modified lines of code are flagged by ***
;arguments: 1. string pointer
; 2. max. no of characters
; 3. lh = flags bit 0: break on ctrls (exc. editing)
; bits 10-17: timing in seconds for whole
; line (no timing if zero)
; rh = bits 18-26: special char to break on
; bits 27-35: second special char to break on
; 4. lh = no. of characters to skip on startup
; if b2 of 3 set.
; rh = break table address if b0 of 3 set.
; 5. optional string pointer if b1 of 3 set.
;table to control editing features
ctrtab: byte (9)400,401,202,203
byte (9)204,205,206,207
NOT20,< byte (9)210,011,405,213
byte (9)214,215,216,217 >;NO TOPS20
T20,< BYTE (9)210,011,212,213
BYTE (9)214,015,216,217 >;TOPS20
byte (9)220,221,404,223
byte (9)224,225,026,402
byte (9)403,231,232,233
t20,< byte (9)234,235,236,215>
not20,< byte (9)234,235,236,212>
xxx==40
repeat 27,<
byte (9)xxx,xxx+1,xxx+2,xxx+3
xxx=xxx+4 >
byte (9)174,375,375,401
ctrtae==.-ctrtab
; string input routine
; enter here via JSR .PSTIN
;*** open
^^.pstin: 0
MOVEM 17,PSTACS+17
SETOM PSTFLG ;ONLY 17 SHOULD BE RESTORED
HRRZI 17,PSTACS
BLT 17,PSTACS+16 ;SAVE FAIL ACS
HRRZM 17,PSTFLG ;NOW ALL MAY BE RESTORED
MOVE PPP,[XWD -PSSLEN,PSTACK-1]
;*** close
setz 15,0 ;used for rfmod on backspace
MOVEI 1,100
RFMOD
PUSH PPP,2 ;SAVE MODES
TRO 2,17B23 ;BREAK ON EVERYTHING
SFMOD
rfcoc
push PPP,2
push PPP,3
tlz 2,140000 ;ctrl a
tlz 3,600360 ;ctrl r,w,x
trz 3,600000 ;altmod
sfcoc
TIME
push PPP,1 ; -1(PPP) time
setz 7,0 ;flag register
IFN IMSSSW,<
gjinf ;THIS IS THE WRONG THING TO DO YOU KNOW...
movei 1,400000(4)
gttyp
andi 2,37 ;test for imlac
cain 2,12
tlo 7,(1b16) ;imlac
cain 2,11
tlo 7,(1b15) ;OR TEC
>;END OF IMSSS
move 5,PSTACS+1 ;***
hrlzi 1, 440700
jumpg 5, psin0
caml 5, [777777000000]
hllm 1, PSTACS+1 ;***
psin0: move 4, PSTACS+1 ;*** string ptr
IFN KAFLG,<TLZ 4,20>
IFN KIFLG,<TLZ 4,37>
move 5,4 ; starting pointer
move 6,PSTACS+3 ;*** get flags
move 16,PSTACS+2 ;*** get byte count
tlnn 6,(1b2) ;skip bytes
jrst psin1 ; no
move 10,5
move 11,PSTACS+4 ;***
hlrz 11,11 ; get byte count
jumple 11,psin1
sub 16,11 ; update byte count left
PUSHJ PPP,bpplus ; add to byte pointer
move 4,11
psin1: skipg 16 ; get total count
tlo 7,(1b0) ; set break
psin2: tlne 7,(1b0) ; break
jrst psend
IFN IMSSSW,<
tlnn 6,777 ; timing
jrst [ pbin
jrst psin22 ]
PUSHJ PPP,pstim ;check time
psin25: jrst [ movei 1,222
jrst psin24 ]
pbtin
cain 1,22
jrst psin25
>;END OF IMSSS
IFE IMSSSW,< PBIN>
psin22: ldb 2,[point 7,6,26]
ldb 3,[point 7,6,35]
caie 2,(1)
cain 3,(1)
tlo 7,(1b0) ; break
idivi 1,4
tlnn 6,(1b0) ;break table specified
jrst [ move 3,ctrtab(1)
jrst psin23 ]
move 3,PSTACS+4 ;***
addi 1,(3)
move 3,(1) ;***
psin23: xct psinb(2)
trze 1,400
jrst psin4 ;special handling
psin24: PUSHJ PPP,pscha
jrst psin2 ;loop
psin4: cail 1,psedl
setz 1,0
xct psedr(1)
jrst psin2 ;loop
psinb: ldb 1,[point 9,3,8]
ldb 1,[point 9,3,17]
ldb 1,[point 9,3,26]
ldb 1,[point 9,3,35]
psedr: jfcl 0 ;noop
PUSHJ PPP,psdel ;delete charachter
PUSHJ PPP,psbaw ;delete word
PUSHJ PPP,psbal ;delete line
PUSHJ PPP,psret ;retype line
PUSHJ PPP,pslf ;special linefeed handling
psedl==.-psedr
;bpPlus, dbp, countB
bp1==10
bp2==11
cnt==11
tmp1==12
tmp2==13
; Add to byte pointer
; -------------------
; Accepts:
; BP1: Byte pointer
; CNT: Byte count, must be at least -500000 (octal), and
; may not cause BP1 to wrap around memory
; Returns:
; BP1: unchanged
; CNT: Updated byte pointer such that "LDB" will work (at
; least one "IBP" has been performed on the pointer)
; CNT+1: lost
bpPlus:
;=====
addi cnt, 500004 ; Add 100001 (full) words to make the
; count positive. Assures non-
; negative remainder in division.
; One byte discrepency for initial IBP.
idivi cnt, 5 ; Divide it to full words
; and left-over bytes (in CNT+1)
subi cnt, 100001 ; Remove the added words
add cnt, bp1 ; CNT becomes the new pointer
ibp cnt ; Add left-over byte
sojge cnt+1, .-1 ; All left-over bytes done?
popj PPP, ; Yes
; Decrement byte pointer
; ----------------------
; Accepts:
; BP1: Byte pointer
; Returns:
; BP1: The byte pointer decremented by one byte
dbp:
;==
add bp1, [xwd 70000,0] ; Put back one byte
tlne bp1, 400000 ; Owerflow to previous word?
sub bp1, [xwd 430000,1] ; Yes, account for it
popj PPP,
; Count bytes between two byte pointers
; -------------------------------------
; Accepts:
; BP1: First (from) byte pointer
; BP2: Second (to) byte pointer
; Returns:
; BP1: unchanged
; BP2: Byte count from BP1 to BP2
; TMP1: lost
; TMP2: lost
countB:
;=====
ldb tmp1, [point 6,bp1,5] ; Bits to the right of byte 1
ldb tmp2, [point 6,bp2,5] ; Bits to the right of byte 2
subi tmp1, (tmp2) ; Bit difference
idivi tmp1, 7 ; Within-word byte difference
subi bp2, (bp1)
hrre bp2, bp2 ; Full word difference
imuli bp2, 5 ; Convert it to byte difference
add bp2, tmp1 ; Add count derived form within-word bytes
popj PPP,
;pscha, psdel, psbaw
pscha: tlze 7,(1b1) ;rubout in progress
jrst [ push PPP,1
movei 1,"]"
tlnn 7,(1B15+1b16) ; imlac OR TEC
pbout
pop PPP,1
PUSHJ PPP,psrmod
tlnn 7,(1B15+1b16)
pbout
tlnn 7,(1b16) ;to correct prob of
caie 1, 215 ;cr terminating delete
jrst .+1 ;no prob on imlac
movei 1, 12 ;must have lf to get off
pbout ;same line as delete
movei 1, 215 ;since only cr was sent
jrst .+1 ] ;fixed 8-2-73 /ron
IFN KAFLG,<TLZ 4,20>
IFN KIFLG,<TLZ 4,37>
idpb 1,4 ;***
sosle 16
trne 1,200 ;break charachter
tlo 7,(1b0) ;yes
POPJ PPP,
psdel: move 10,5
move 11,4
PUSHJ PPP,countb ;how many left
jumpe 11,psbal ;none left-line delete
PUSHJ PPP,psmod ;set no echo
movei 1,"["
tlnn 7,(1b1+1B15+1b16)
pbout
tlo 7,(1b1) ;set rubout in progress
aos 16
IFN KAFLG,<TLZ 4,20>
IFN KIFLG,<TLZ 4,37>
ldb 1,4 ;*** get byte
cain 1,12
jrst psdel2 ;special handling for lf
tlne 7,(1B15+1b16) ;imlac OR TEC
JRST [PUSHJ PPP,PSDELC ;;;MOVei 1,177
JFCL ;ILLEGAL OR LINE EMPTY
JRST PSDEL1]
pbout
psdel1: move 10,4
PUSHJ PPP,dbp ;decr. byte pointer
move 4,10
POPJ PPP,
psdel2: hrroi 1,[asciz /^^
/]
psout
jrst psdel1
psbaw: trz 7,1 ;backspace word
move 10,5
move 11,4
PUSHJ PPP,countb ;how many bytes left
jumpe 11,psbal
tlne 7,(1B15+1b16) ;imlac OR TEC
jrst psbaw1
hrroi 1,[asciz /__ /]
psout
psbaw1: IFN KAFLG,<TLZ 4,20>
IFN KIFLG,<TLZ 4,37>
ldb 1,4 ;***
cain 1,12 ;line feed is special
jrst psbaw3
caie 1,40 ;space
cain 1,11 ;tab
jrst [ trnn 7,1
jrst .+2
POPJ PPP,]
tro 7,1 ;set char. found flag
;;; movei 1,177
;;; tlne 7,(1b16) ;imlac
;;; pbout
TLNN 7, (1B15+1B16) ;IMLAC OR TEC
JRST PSBAW2
PUSHJ PPP,PSDELC ;DO DELETE
JFCL ;DON'T WORRY IF EMPTY
psbaw2: aos 16 ;incr. byte count
move 10,4
PUSHJ PPP,dbp ;decr. byte pointer
move 4,10
move 10,5
move 11,4
PUSHJ PPP,countb
jumpn 11,psbaw1 ;not done yet
POPJ PPP,
psbaw3: trne 7,1 ;already char. found
POPJ PPP, ;yes, all done
hrroi 1,[asciz /^^
/]
psout
jrst psbaw2
pslf: movei 1,15
pbout ;send line feed
movei 1,12
jrst pscha
psmod: tlne 7,(1b1+1B15+1b16)
POPJ PPP, ;not for imlac or if in rubout mode
movei 1,100
rfmod
move 15,2 ;save in ac15
trz 2,3b25 ;reset echo mode
sfmod
POPJ PPP,
psrmod: skipn 2,15 ;echo mode saved
POPJ PPP, ;no
push PPP,1
movei 1,100
sfmod
setz 15,0 ;reset flag
pop PPP,1
POPJ PPP,
IFE IMSSSW,<PSDELC: POPJ PPP,>
IFN IMSSSW,<
PSDELC: MOVEI 1, 101 ;PRIMARY OUTPUT
DELCH
JFCL ;*** + 1 - NOT TTY - SHOULDN'T GET HERE
POPJ PPP, ;+ 2 - EMPTY LINE, NO SKIP
JRST [AOS (PPP) ;+ 3 -- SKIP IF DONE OK
POPJ PPP,]
JFCL ;*** + 4 - IF NOT DISPLAY
POPJ PPP, ;A LOZER
>;END OF IMSSS
psbal: move 4,PSTACS+1 ;*** del line
move 5,4
move 16,PSTACS+2 ;***
psbal1: movei 1,"#"
pbout
pbout
movei 1,37
pbout
tlz 7,(1b1) ;reset rubout mode
PUSHJ PPP,psrmod ;reset echo mode
tlnn 6,(1b1) ;optioanal string
POPJ PPP, ;no
move 2,PSTACS+5 ;***
jumpg 2,psbal2
caml 2,[ 777777000000 ]
hrli 2, 440700
psbal2: IFN KAFLG,<TLZ 2,20>
IFN KIFLG,<TLZ 2,37>
ildb 1,2 ;***
jumpe 1,Scpopj ;*** to POPJ PPP,
pbout
jrst psbal2 ;keep looping
psret: PUSHJ PPP,psbal1 ;clean up at end of line
move 10,5
move 11,4
PUSHJ PPP,countb ;count bytes left
move 2,5
psret1: sojl 11,Scpopj ;*** to popj PPP, - no more
IFN KAFLG,<TLZ 2,20>
IFN KIFLG,<TLZ 2,37>
ildb 1,2 ;***
cain 1,12 ;line feed
movei 1,37 ; make eol
pbout
jrst psret1
psend: movem 4,PSTACS+1 ;***
movem 16,PSTACS+2 ;***
pop PPP,1 ;time
pop PPP,3
pop PPP,2
movei 1,100
sfcoc ;reset tty modes
pop PPP,2
sfmod
;*** open
HRLZI 17,PSTACS ;restore FAIL ACS
BLT 17,17
SETZM PSTFLG ;FLAG OUT SAFELY
JRST @.PSTIN
;*** close
IFN IMSSSW,<
pstim: ldb 3, [point 8, 6, 17] ; do timing
TIME
sub 1, -1(PPP)
lsh 1, -^d10 ; conv to seconds
sub 3, 1
jumple 3, pstim1
aos (PPP) ; double skip
move 1,3 ; return time lept
pstim1: POPJ PPP,
>;END OF IMSSS
BEND PSTIN
>;END IFE PSTISW >;NOT20
>;END TNX
END STRT