Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0088/pilot.mac
There is 1 other file named pilot.mac in the archive. Click here to see a list.
SEARCH PILUNV
.TITLE PILOT INITIALIZATION
PILOT: TDZA F,F ;CLEAR FLAGS
MOVSI F,FL.CCL ;CCL ENTRY
START: RESET ;RESET ALL I/O
MOVE P,PDP ;SET UP PDL
MOVE T1,.JBFF ;GET FIRST FREE
CORE T1, ;SHRINK CORE BACK DOWN
JRST CORERR ;IMPROBABLE
SETZB P2,LOOKIT ;TEMP (P2) & 1ST LOC OF TEMP STORAGE
MOVE T1,[FILNAM,,FILNAM+1] ;REST OF TEMP STORAGE
MOVE T2,.JBREL ;ALL THE WAY UP TO TOP OF CORE
BLT T1,(T2) ;BBLLLIIIITTTTT!
MOVE P1,[POINT 6,P2] ;TEMP POINTER
TLNE F,FL.CCL ;CCL INPUT?
JRST CCLIN ;YES
STAR: OUTSTR ASTER ;HERE IF TTY INPUT
INCHWL I ;GET CHAR
CAIL I,40 ;SPECIAL CHAR?
JRST LOOP1 ;NO--PROCESS
CAIN I,"Z"-100 ;TTY EOF?
EXIT 1, ;YES
CLRBFI ;CLEAR BUFFER
JRST STAR ;& TRY AGAIN
INITMP: SETZ P2, ;CLEAR P2
MOVE P1,[POINT 6,P2] ;RESTORE BYTE POINTER
LOOP: PUSHJ P,INCH ;GET CHARACTER FROM WHEREVER
JUMPE I,XIT ;NULL--END OF THE LINE.
LOOP1: CAIN I,40 ;SPACE?
JRST LOOP ;YES, IGNORE
CAIN I,":"
JRST LOADEV ;IF COLON-LOAD THE DEVICE
CAIE I,"="
CAIN I,"_"
JRST BACK ;IF _ OR = STORE REL OR LIST FILE NAME
CAIN I,","
JRST LODRL1 ;IF , STORE REL FILE NAME
CAIN I,"!"
JRST RUNAME ;IF ! RUN THE PROGRAM
CAIN I,"."
JRST LODFIL ;IF . LOAD THE FILE NAME
CAIN I,"["
JRST LODPPN ;IF [ STORE EXT & PROCESS PPN
CAIN I,"]"
JRST LOOP ;IGNORE ]
CAIGE I,40
JRST DONE ;IF BREAK, WE'RE DONE
CAIE I,"("
CAIN I,"/"
JRST DONE ;IF A SWITCH, WE'RE DONE TOO.
SUBI I,40 ;CONVERT TO SIXBIT
TLNE P1,770000 ;> 6 CHAR?
IDPB I,P1 ;NO STUFF
JRST LOOP ;LOOP
LOADEV: SKIPE DEVICE ;IF DEVICE ALREADY FULL
JRST TWODEV ;HOLLER
MOVEM P2,DEVICE ;STORE DEVICE
JRST INITMP ;INIT TEMP & LOOP
LODFIL: SKIPE FILNAM ;FILE NAME ALREADY THERE?
JRST TWOFIL ;YES
MOVEM P2,FILNAM ;STORE FILE NAME
JRST INITMP ;& LOOP
BACK: TRNN F,FR.LST ;IF LISTING,
JRST LODRL1+1 ;LOAD REL FILE
SKIPN T1,FILNAM ;SKIP & LOAD IF FILE NAME THERE
MOVE T1,P2 ;ELSE LOAD TEMP
MOVEM T1,LSTNAM ;LOAD LIST FILE NAME
SETZM FILNAM ;CLEAR OLD FILE NAME
CAME P2,LSTNAM ;DID WE LOAD TEMP ALREADY?
MOVEM P2,LSTEXT ;NO-TEMP CONTAINS LST EXT.
MOVE T1,DEVICE ;LOAD THE DEVICE
MOVEM T1,LSTDEV ;TRANSFER
SETZM DEVICE ;AND CLEAR DEVICE
JRST INITMP ;LOOP
LODRL1: TRO F,FR.LST ;COMMA INPLIES LIST FILE
SKIPN T1,FILNAM ;SKIP & LOAD IF FILE NAME THERE
MOVE T1,P2 ;ELSE LOAD TEMP
MOVEM T1,RELNAM ;LOAD RELFILE NAME
SETZM FILNAM ;CLEAR FILE NAME
CAME P2,RELNAM ;DID WE LOAD TEMP?
MOVEM P2,RELEXT ;NO-LOAD RELFILE EXT.
JRST INITMP ;LOOP
LODPPN: SETZ T1,
SKIPE PPN
JRST TWOPPN
PUSHJ P,GETOCT
CAIE I,","
JRST ILLDEL
HRLZM T1,PPN
SETZ T1,
PUSHJ P,GETOCT
HRRM T1,PPN
JRST LOOP1
DONE: PUSHJ P,SWITCH ;GO FIND SWITCHES (IF ANY)
;THIS ALSO EATS <CR><LF> IF ANY
TRZN F,FR.HLP ;NEED HELP?
JRST .+3 ;NO HELP NEEDED
MOVE 1,[SIXBIT/PILOT/] ;THATS US
PUSHJ P,.HELPR ;SHOULD BE .REQUEST'ED
SKIPN T1,DEVICE ;IF DEVICE IS OMITTED...
HRLZI T1,'DSK' ;... "DSK" IS ASSUMED
MOVEM T1,DEVICE ;STORE THE DEVICE
SKIPE FILNAM ;IF THERE IS A FILE NAME
JRST TSTEXT ;SEE IF THERE IS AN EXTENSION
SKIPN T1,P2 ;IS THERE SOMETHING IN TEMP?
JRST START ;NO - BAD SYNTAX
MOVEM T1,FILNAM ;MOVE WHATEVER
JRST DO.IO ;AND START DOING THE I/O
TSTEXT: SKIPN FILEXT ;ALREADY FILE EXTENSION?
HLLZM P2,FILEXT ;NO--STORE TEMP
DO.IO: PUSHJ P,RDX50 ;COMPUTE FILENAME
MOVEM T3,R50NAM ;& SAVE FOR PILOTC
MOVEI T1,14 ;BINARY MODE
SETZ T4,
MOVE T2,DEVICE ;INPUT DEVICE
HRRZI T3,IBUF
OPEN IN,T1
JRST NODEV
RELOOK: MOVE T1,FILNAM
MOVE T2,FILEXT
SETZ T3,
MOVE T4,PPN
LOOKUP IN,T1
JRST NOFILE
TRNN F,FR.LST ;NEED A LIST FILE?
JRST NOLST ;NO
SETZ T1,
SKIPN T2,LSTDEV
MOVSI T2,'DSK'
HRLZI T3,LSTBUF
OPEN LST,T1
JRST NODEV
SKIPN T1,LSTNAM
MOVE T1,FILNAM
SKIPN T2,LSTEXT
MOVSI T2,'LST'
SETZB T3,T4
ENTER LST,T1 ;MAKE THE LISTFILE
JRST ENTERR
NOLST: TLNN F,FL.CCL
JRST COMND
OUTSTR [ASCIZ/PILOT: /]
PUSHJ P,TYPE
OUTSTR [ASCIZ/
/]
SETZ P2,
MOVEM P3,TMPPTR ;SAVE TMPCOR BUFFER POINTER
JRST COMND ;GO DO WHAT THE FILE SAYS TO DO
GETOCT: PUSHJ P,INCH
CAIN I,40
JRST GETOCT
CAIG I,"7"
CAIGE I,"0"
POPJ P,
IMULI T1,10
ADDI T1,-60(I)
JRST GETOCT
RUNAME: PUSHJ P,INCH
CAIN I,15
PUSHJ P,INCH
MOVEI T1,T2
HRLI T1,1
SKIPN T2,DEVICE
MOVSI T2,'SYS'
MOVE T3,P2
SETZB T4,T4+1
SETZB T4+2,T4+3
RUN T1,
HALT
RDX50: MOVE T1,[POINT 6,RELNAM] ;USE RELFILE NAME
SKIPN RELNAM ;UNLESS ITS EMPTY,
MOVE T1,[POINT 6,FILNAM] ;THEN USE INPUT FILE NAME
SETZ T3,
RDX51: TLNN T1,770000
POPJ P,
ILDB T2,T1
JUMPE T2,.+4
SUBI T2,17 ;IF NUMERIC THIS WILL DO
CAIL T2,13 ;WAS IT?
SUBI T2,7 ;NO DO FOR ALPHA
IMULI T3,50 ;SHIFT TOTAL
ADD T3,T2 ;ADD IN
JRST RDX51 ;LOOP
PUSHJ P,INCH
SWITCH: JUMPE I,CPOPJ ;POPJ IF NULL
CAIE I,"(" ;OPEN PAREN?
CAIN I,"/" ;SLASH?
JRST SW1 ;YES
CAIE I,12
CAIN I,33 ;LF OR ALT.
POPJ P, ;YES. DONE
CAIN I,")" ;CLOSE PAREN
JRST SWITCH-1 ;YES-IGNORE
CAIE I,CR ;CR?
JRST SW1+1 ;NO-SEE IF ITS A SWITCH
PJRST INCH ;GET LF
SW1: PUSHJ P,INCH ;GET SWITCH
MOVSI T1,-STABLN ;TABLE LENGTH
HLRZ T2,SWITAB(T1) ;GET TABLE ENTRY
CAME I,T2 ;MATCH?
AOBJN T1,.-2 ;NO, LOOP
JUMPGE T1,BADSWT ;NO MATCH
HRRZ T2,SWITAB(T1) ;GET FLAG
IOR F,T2 ;LIGHT BITS
JRST SWITCH-1 ;GET NEXT THING
SWITAB: SW (N,FR.TTY) ;N = NO TTY ERROR REPORTING
SW (M,FR.MAP) ;M = GIVE A LITTLE MAP
SW (H,FR.HLP) ;HELP!!
STABLN==.-SWITAB
BADSWT: OUTSTR [ASCIZ/
? UNKNOWN SWITCH "/]
OUTCHR I
OUTSTR [ASCIZ/"
/]
XIT: EXIT
INCH: TLNN F,FL.CCL ;CCL INPUT?
JRST .+3 ;NO, SKIP
ILDB I,P3 ;GET TMPCOR CHAR
JRST .+2 ;JUST IN CASE...
INCHWL I ;GET TTY CHAR.
CAIL I,140 ;IF LOWER CASE,
SUBI I,40 ;CONVERT TO UPPER CASE
CPOPJ: POPJ P, ;RETURN
TYPE: MOVE T2,[POINT 6,T1]
TLNN T2,770000
POPJ P,
ILDB T3,T2
JUMPE T3,.-3
ADDI T3,40
OUTCHR T3
JRST TYPE+1
NODEV: MOVE T1,T2
OUTSTR [ASCIZ/CANNOT OPEN DEVICE /]
PUSHJ P,TYPE
OUTSTR [BYTE (7) 15,12,0,0,0]
JRST START
ENTERR: OUTSTR [ASCIZ/ENTER ERROR FOR FILE /]
PUSHJ P,TYPE
HLRZ T1,T2
JUMPE T1,.+3
OUTCHR ["."]
PUSHJ P,TYPE
OUTSTR [BYTE (7) 15,12,0]
JRST START
NOFILE: SKIPE FILEXT
JRST .+4
MOVSI T1,'PIL'
MOVEM T1,FILEXT
JRST RELOOK
MOVE T1,FILNAM
OUTSTR [ASCIZ/NO SUCH FILE /]
PUSHJ P,TYPE
MOVE T1,FILEXT
JUMPE T1,.+3
OUTCHR ["."]
PUSHJ P,TYPE
OUTSTR [BYTE (7) 15,12,0,0,0]
JRST START
TWODEV: OUTSTR [ASCIZ/TWO DEVICES
/]
JRST CSTART
TWOFIL: OUTSTR [ASCIZ/TWO FILE NAMES
/]
JRST CSTART
TWOEXT: OUTSTR [ASCIZ/TWO FILE EXTENSIONS
/]
JRST CSTART
TWOPPN: OUTSTR [ASCIZ/TWO PPNS
/]
JRST CSTART
ILLDEL: OUTSTR [ASCIZ/ILLEGAL DELIMITER IN PPN
/]
CSTART: TLNN F,FL.CCL ;CCL INPUT?
CLRBFI ;SHOULDN'T BE
JRST START ;RESTART SCAN
CORERR: OUTSTR [ASCIZ/?CANNOT SHRINK CORE
/]
JRST CSTART
ASTER: ASCIZ /
*/
CCLIN: SKIPE P3,TMPPTR ;WAS THERE A TMPCOR BUFFER POINTER?
JRST INITMP ;YES--LOADED & GONE
MOVE T1,[2,,TMPBLK] ;NO, GET TMPCOR FILE
TMPCOR T1,
PUSHJ P,NOTEMP
MOVE P3,[POINT 7,TBUF]
JRST INITMP
NOTEMP: MOVEI T1,17 ;NO TMPCOR--TRY DISK
MOVSI T2,'DSK'
SETZB T3,T4
OPEN TMPC,T1 ;OPEN DISK
JRST NODEV
PJOB T1, ;GET JOB NUMBER
SETZ T3,
IDIVI T1,12 ;AND CONVERT
TRO T2,20 ;TO TMPDISK FILE NAME
LSHC T2,-6 ;BY THE TRIED & TRUE METHOD
TLNN T3,77
JRST .-4
MOVE T1,T3
HRRI T1,'PIL'
MOVSI T2,'TMP' ;NNNPIL.TMP
SETZB T3,T4
LOOKUP TMPC,T1 ;LOOKUP
JRST PILOT ;NO CCL FILE, ASSUME TTY INPUT
INPUT TMPC,TMPBLK+1 ;PUT INTO TMPCOR BUFFER
SETZ T1,
RENAME TMPC,T1 ;DELETE TMPDSK FILE
JRST NOREN ;FAILURE
RELEAS TMPC,
POPJ P, ;BACK
NOREN: OUTSTR [ASCIZ/CANNOT DELETE TEMP DISK FILE
/]
EXIT
PDP: IOWD 100,PDL
TMPBLK: SIXBIT /PIL/
IOWD 20,TBUF
0
PRGEND PILOT
SEARCH PILUNV
.TITLE PILLOW - PILOT LOW SEG
RELOC 0
TBUF: BLOCK 20 ;DONT CLEAR TMPCOR BUFFER
TMPPTR: BLOCK 1 ;HOLDS TMPCOR BYTE POINTER
LOOKIT:
FILNAM: BLOCK 1
FILEXT: BLOCK 1
BLOCK 1
PPN: BLOCK 1
RELNAM: BLOCK 1
RELEXT: BLOCK 1
LSTNAM: BLOCK 1
LSTEXT: BLOCK 1
DEVICE: BLOCK 1
LSTDEV: BLOCK 1
R50NAM: BLOCK 1 ;RADIX 50 FILE NAME FOR RELFILE
LASTOP: BLOCK 1 ;LAST OPCODE USED
LINE: BLOCK 1 ;INTERNAL LINE NUMBER
EDLINE: BLOCK 1 ;LINE NUMBER FROM SOS
BLOCK 1 ;FOR ASCIZ
LINCNT: BLOCK 1 ;LINE OF PAGE
PAGE: BLOCK 1 ;PAGE COUNT
SUBPAG: BLOCK 1 ;SUBPAGE COUNT
ERRORS: BLOCK 1 ;NUMBER OF ERRORS
STRTIM: BLOCK 1 ;RUNTIME AT START OF COMPILATION
SVJBFF: BLOCK 1 ;SAVE .JBFF
LOC: BLOCK 1 ;CURRENT LOCATION IN PROGRAM
ENDLOC: BLOCK 1 ;CURRENT FIRST FREE LOC IN PROGRAM
FSTLOC: BLOCK 1 ;FIRST USER SUPPLIED INSTRUCTION
LITLOC: BLOCK 1 ;FIRST LITERAL LOCATION
PROGRM: BLOCK 1 ;ABS ADDRESS OF PROGRAM START
PDL: BLOCK 100 ;PDL STORAGE
IBUF: BLOCK 3
OBUF: BLOCK 3 ;BUFFER HEADERS
LSTBUF: BLOCK 3 ;LISTING FILE
SYMTAB: BLOCK SYMAX ;SYMBOL TABLE
PASS1B: BLOCK 100 ;PASS 1 ERRORS FOR LISTING
ENDLOW=. ;TOP OF LOWSEG
PRGEND
SEARCH PILUNV
.TITLE PILCOD - CODE GENERATION
DEFINE C (X,Y,Z),<XALL
ASCII /X/
SALL>
CTAB1: CNAMES
CTAB1L==.-CTAB1
DEFINE C (X,Y,Z),<
XALL
Y,,Z
SALL>
CTAB2: CNAMES
SUBTTL INITIALIZATION
COMND: SETZ T1, ;ZERO MEANS MYSELF
RUNTIM T1, ;GET RUNTIME
MOVEM T1,STRTIM ;SAVE IT
SETZM LOC ;START AT LOC 0
SETZB BUFPTR,BUF ;NO INPUT
SETZM LINE ;LINE 0
MOVE T1,.JBFF ;GET FIRST FREE
MOVEM T1,SVJBFF ;SAVE FIRST FREE
TRNE F,FR.LST
PUSHJ P,HEDDR0 ;IF LISTING DO FIRST HEDDER
SETZB P3,I ;CLEAR MISC.
PUSHJ P,INCHL ;MAKE INPUT BUFFER
MOVE T1,.JBFF ;GET NEW FIRST FREE ABOVE BUFFER
MOVEM T1,PROGRM ;SO PROGRAM CAN GO ABOVE IT
PUSHJ P,INIT ;INITIAL OVERHEAD
TRNE F,FR.EOF ;EMPTY FILE?
JRST EOF ;NO NEED TO SCAN THEN
SUBTTL OPCODE SCANNER
SCANER: TRO F,FR.IGS!FR.NLC ;LOWER CASE & IGNORE SPACES
PUSHJ P,INCH ;GET 1ST CHAR
TRNE F,FR.P2 ;IF ON PASS2
TRNN F,FR.LST ;AND NOT LISTING
AOS LINE ;NEWLINE
SCAN2: TRNE F,FR.EOF ;EOF?
JRST EOF ;YES, WRAP IT UP.
MOVE T1,[POINT 7,T2] ;MAKE BYTE POINTER
SETZ T2, ;CLEAR DESTINATION
MOVEI T3,5 ;MAX CHARACTERS TO LOAD
CAIN I,CR ;LEADING CR?
JRST WASTE ;YES--TRY AGAIN
CAIN I,LF ;OR LF
JRST SCANER ;YOU NEVER KNOW...
CAIE I,"*" ;TAG?
JRST SCAN3+1 ;NO
MOVE T2,[ASCIZ/*/] ;TAGS HAVE NO COLON,
JRST SCAN4 ;SO DUMMY UP ONE
SCAN3: PUSHJ P,INCH ;GET CHAR
CAIN I,CR ;EOL?
BOMB F.SCAN ;BAD OPCODE IF CR BEFORE :
CAIN I,COLON ;COLON?
JRST SCAN4 ;OPCODE TERMINATOR
IDPB I,T1 ;STUFF BYTE
SOJG T3,SCAN3 ;COUNT&JUMP
BOMB F.SCAN ;5 CHAR & NO :
SCAN4: TRZ F,FR.NLC ;LOWER CASE ENABLED
SKIPN T2 ;JUST COLON?
MOVE T2,LASTOP ;YES--GET LAST OPCODE
MOVSI T3,-CTAB1L ;TABLE LENGTH
CAME T2,CTAB1(T3) ;MATCH?
AOBJN T3,.-1 ;NO, LOOP
SKIPL T3 ;FOUND IT?
BOMB F.SCAN ;NO
CAME T2,[ASCIZ/*/] ;TAGS DON'T COUNT AS OPCODES
MOVEM T2,LASTOP ;YES SAVE IT FOR NEXT LINE
TRNE F,FR.P2 ;PASS 2?
SKIPA T1,CTAB2(T3) ;YES, GET PASS2 ADDRESS & SKIP
HLRZ T1,CTAB2(T3) ;GET PASS1 ADDRESS
JRST (T1) ;DISPATCH
SUBTTL TAG PROCESSING
TAG: PUSHJ P,LTAG ;LOAD TAG
JUMPE T2,[BOMB (F.NTAG)];NO TAG LOADED
PUSHJ P,SRCTAB ;SEARCH TABLE
JRST TG2 ;NO MATCH
BOMB F.2TAG ;MULTIPLY DEFINED TAG
TG2: MOVEM T2,SYMTAB(T1) ;LOAD SYMBOLIC TAG
MOVE T2,LOC ;GET ACTUAL ADDRESS
MOVEM T2,SYMTAB+1(T1) ;SAVE ADDRESS
TRO FR.IGS!FR.NLC ;IGNORE SPACES & LC
PUSHJ P,INCH ;GET NEXT
CAIE I,CR ;EOL?
CAIN I,LF ;..
JRST SCANER ;YES--START NEW LINE
JRST SCAN2 ;NO--SCAN REST OF LINE
SUBTTL TYPE COMMAND
TYPE: SETZ LC, ;CLEAR TEMP LOCATION REGISTER
JRST TYP1.4 ;AND PROCESS
TYPEY: MOVE LC,LOC ;SET TEMP LOCATION ADDRESS
STORE <JUMPE 1,0> ;TY: STARTS WITH A JUMPE 1,
JRST TYP1.4 ;& DO REST
TYPEN: MOVE LC,LOC ;SET TEMP ADDRESS REGISTER
STORE <JUMPN 1,0> ;TN: = JUMPN 1,
TYP1.4: TRZ F,FR.IGS!FR.SUP ;STOP IGNORING SPACES
PUSHJ P,INCH ;GET VERY FIRST CHAR.
CAIE I,"/" ;SLASH?
JRST TYP1.5 ;NO - SKIP
TRO F,FR.SUP ;SUPRESSING CR
PUSHJ P,INCH ;YES--IGNORE 1ST SLASH
TYP1.5: CAIN I,CR ;EOL?
JRST TYPEND ;SEE IF DONE
CAIN I,DOLLAR ;POSSABLY A DATA NAME?
JRST TYP1.6 ;YES
CAIN I,AT ;CURSER COMMAND?
JRST TYP1.7 ;YES
TRO F,FR.TLT ;NO, ITS A LITERAL
TRZE F,FR.TTG ;& SEEN TAG?
STORE <OUTSTR> ;STUFF TYPE OPCODE
TRZE F,FR.TAT ;AT?
STORE <IONEOU> ;YES
JRST TYP1.5-1 ;LOOP
TYP1.6: PUSHJ P,LTAG ;LOAD TAG
JUMPE T2,TYP1.5 ;NO TAG IS NO TAG
TRZE F,FR.TTG!FR.TLT ;TAG OR LITERAL?
STORE <OUTSTR> ;YES, LOAD OPCODE
TRZE F,FR.TAT ;AT?
STORE <IONEOU> ;YES
TRO F,FR.TTG ;WE HAVE A TAG
JRST TYP1.5 ;LOOP
TYP1.7: CLEAR T4, ;CLEAR AC
PUSHJ P,INCH ;GET COMMAND
CAIG I,"9" ;TEST FOR NUMERIC
CAIGE I,"0" ;..
JRST .+4 ;NOT NUMERIC
IMULI T4,^D10 ;BUMP
ADDI T4,-60(I) ;SAVE NUMBER IN T1
JRST TYP1.7+1 ;GET REST OF NUMBER
CAIE I,DOLLAR ;@$??
JRST .+3 ;NO
TRO F,FR.TLT ;YES-THEN THE @ IS A LITERAL
JRST TYP1.6 ;AND DO THE TAG
MOVSI T2,-ATTABL ;GET LENGTH OF COMMAND TABLE
HRRZ P1,ATTAB(T2)
CAME I,P1 ;IN TABLE?
AOBJN T2,.-2 ;NO-LOOP
JUMPGE T2,TYP1.5 ;NOT @, NOT $ ;ERGO A LITERAL
TRZE F,FR.TLT!FR.TTG ;OTHERS?
STORE <OUTSTR> ;YES
TRZE F,FR.TAT ;OR OTHER @?
STORE <IONEOU> ;YES
TRO F,FR.TAT ;AT LAST!
HLRZ T2,ATTAB(T2) ;GET VALUE OF COMMAND
JUMPE T2,TYP1.8 ;JUMP IF SPECIAL CURSER COMMAND
SOJ T4, ;MINUS ONE
JUMPLE T4,TYP1.5-1 ;NO REPEATS
SOJG T4,.+3 ;JUMP IF MORE THAN 2
STORE <IONEOU> ;STORE OPCODE
JRST TYP1.5-1 ;DONE
ADDI T4,2 ;RESET TO CORRECT NUMBER
MOVE T1,T4 ;SAVE IT
HLL T1,[HRRZI 2,] ;1ST INSTRUCTION
PUSHJ P,STOREX ;STORE INSTR.
MOVE T3,LOC ;SAVE LOCATION
STORE <IONEOU> ;SECOND INSTR.
MOVE T1,[SOJG 2,]
HRR T1,T3 ;COMPLETE INSTR.
PUSHJ P,STOREX ;3RD INSTR.
TRZ F,FR.TAT ;NO OTHERS
JRST TYP1.5-1 ;GO BACK
TYP1.8: TRZ F,FR.TAT ;NO OTHERS
MOVE T1,[IONEOU] ;INSTR.
REPEAT 4,<PUSHJ P,STOREX> ;4 TIMES
JRST TYP1.5-1 ;GO BACK
TYPEND: PUSHJ P,INCH ;EAT LF
AOS LINE ;NEWLINE
TRO F,FR.IGS!FR.NLC ;IGNORE SPACES & LC
PUSHJ P,INCH ;GET NEXT CHAR
CAIN I,CR ;BLANK?
JRST TYPEND ;YES--TRY AGAIN
TRZE F,FR.TTG ;SAW A TAG AT END?
STORE <OUTSTR> ;YES
TRZE F,FR.TAT ;HOW ABOUR @?
STORE <IONEOU> ;YES
TRNN F,FR.SUP ;SUPPRESSING?
TRO F,FR.TLT ;NO FLAG FOR THE CR
CAIN I,COLON ;CONTINUE?
JRST TYP1.4 ;YES - GO DO NEW LINE
TRZE F,FR.TLT ;IF A LIT
STORE <OUTSTR> ;MAKE ONE FOR THE LIT
TRZ F,FR.TAL ;CLEAR FLAGS
JUMPE LC,SCAN2 ;T: HAS NO MODIFIER
ADD LC,PROGRM ;ADD OFFSET
MOVE T1,LOC ;LOCATION TO JUMP TO
HRRM T1,(LC) ;STICK IT BACK THERE
JRST SCAN2 ;START SCANING NEW LINE
TYPYN2: AOS LOC ;BUMP OVER SKIP INST.
TYPE2: MOVE T1,[POINT 7,(T2)]
MOVE T2,ENDLOC ;START OF LITERAL
ADD T2,PROGRM
SETZ T3, ;ZERO COUNT
TRZ F,FR.IGS ;THIS IS A LITERAL
L0: PUSHJ P,INCH ;GET 1ST CHAR.
CAIE I,"/" ;SUPPRESS <CRLF>?
JRST L1+1 ;NO
TRO F,FR.SUP ;YES, SUPPRESS
L1: PUSHJ P,INCH ;GET THE CHARACTER
AOJ T3, ;CHARACTER COUNT
REPEAT 0,<
CAIE I,COLON ;COLON?
JRST L1.5 ;NO, SKIP
PUSHJ P,INCH ;YES, GET CHAR. AFTER :
CAIN I,CR ;IS IT :<CR>?
JRST TLINE ;YES. IGNORE TRAILING COLON
PUSH P,I ;NO, SAVE NEW CHAR.
MOVEI I,COLON ;SIMULATE COLON
IDPB I,T1 ;STUFF COLON
POP P,I ;RESTORE CHAR.
AOJ T3, ;BUMP CHAR. COUNT
L1.5:>
CAIN I,CR ;END OF LINE?
JRST TLINE ;YES, TEST FOR END OF LITERAL
CAIN I,DOLLAR ;TAG?
JRST L4 ;MAYBE..
CAIN I,AT ;CURSER COMMAND?
JRST L3.1 ;MAYBE..
L3: IDPB I,T1 ;STUFF IT
JRST L1 ;DOIT AGAIN
L3.1: SETZ T4,
PUSHJ P,INCH ;GET NEXT CHARACTER
CAIG I,"9" ;NUMERIC?
CAIGE I,"0" ;..
JRST .+4 ;NO
IMULI T4,^D10 ;BUMP
ADDI T4,-60(I) ;ADD
JRST L3.1+1 ;LOOP
MOVSI P1,-ATTABL ;TABLE LENGTH
HRRZ P2,ATTAB(P1) ;GET ENTRY
CAME I,P2 ;MATCH?
AOBJN P1,.-2 ;NO-LOOP
JUMPGE P1,L3.6 ;NO MATCH!!
HLRZ P2,ATTAB(P1) ;GET CHARACTER
SOJ T3, ;DON'T COUNT @
JUMPE T3,L3.2 ;NO LIT
PUSH P,T4 ;SAVE COUNT
IDIVI T3,5
AOJ T3, ;FINISH OFF LITERAL
MOVE T1,ENDLOC ;GET 1ST FREE LOC
MOVE T2,LOC ;GET LOC OF TYPE OPCODE
ADD T2,PROGRM ;ADD OFFSET
HRRM T1,(T2) ;PLUG IN ADDRESS
ADDM T3,ENDLOC
PUSHJ P,CHKEND
AOS LOC
POP P,T4 ;RESTORE T4
L3.2: JUMPE P2,L3.3 ;JUMP IF SPECIAL CURSER COMMAND
MOVE T3,T4 ;SAVE T4
MOVE T1,ENDLOC
ADD T1,PROGRM ;GET ADDRESS
MOVEM P2,(T1) ;STUFF CURSER COMMAND LITERAL
CAIL T4,3 ;DO WE HAVE A LOOP THERE?
AOS LOC ;YES - SKIP OVER THE HRRZ 2,N
MOVE T1,LOC
ADD T1,PROGRM ;GET INSTR. LOC
MOVE T2,ENDLOC ;GET ADDRESS OF LITERAL
HRRM T2,(T1) ;COMPLETE INSTR.
AOJ T1,
CAIG T3,2 ;SKIP IF OVER 2
SOJG T4,.-3 ;LOOP FOR ALL INSTRUCTIONS
AOS ENDLOC
SKIPN T3 ;IF 0 ;
AOS LOC ;ADVANCE ONE
CAIL T3,3 ;IF OVER 2,
MOVEI T3,2 ;MAKE 2
ADDM T3,LOC ;ADVANCE LOC
JRST TYPE2 ;RESTART
L3.3: MOVE T1,ENDLOC ;GET ENDLOC
MOVE T2,LOC
ADD T2,PROGRM ;AND LOC
HRRM T1,(T2) ;COMPLETE INSTR
MOVEI T3,13 ;VERT POS.
ADD T1,PROGRM
MOVEM T3,(T1) ;DO LITERAL
AOS ENDLOC
MOVE T1,ENDLOC
AOJ T2,
HRRM T1,(T2) ;VERT. POS. ARG.
AOS ENDLOC
MOVE T1,ENDLOC
AOJ T2,
HRRM T1,(T2)
MOVEI T3,20 ;HOR. POS.
ADD T1,PROGRM
MOVEM T3,(T1) ;IN LIT.
AOS ENDLOC
MOVE T1,ENDLOC
AOJ T2,
HRRM T1,(T2) ;HOR. POS. ARG.
AOS ENDLOC
MOVEI T2,4
ADDM T2,LOC ;UPDATE LOC
JRST TYPE2 ;DONE
L3.6: MOVEI P2,AT ;SIMULATE @
IDPB P2,T1 ;STUFF
JUMPE T4,L1+1 ;NO NUMERIC ARG.
PUSH P,T4+1 ;SAVE AC FROM DESTRUCTION
PUSHJ P,L3.7 ;SIMULATE NUMERIC ARG
POP P,T4+1 ;RESTORE AC
JRST L1+1 ;RESUME LITERAL
L3.7: IDIVI T4,^D10
JUMPE T4,.+4
PUSH P,T4+1
PUSHJ P,L3.7 ;STANDARD NUMERIC OUTPUT
POP P,T4+1
ADDI T4+1,60
IDPB T4+1,T1
POPJ P,
L4: MOVE T4,T2 ;SAVE T2
PUSHJ P,LTAG ;GET TAG
JUMPN T2,L4.3 ;WE HAVE A TAG
MOVE T2,T4 ;RESTORE T2
MOVEI P1,DOLLAR ;SIMULATE $
IDPB P1,T1 ;STUFF $
JRST L3 ;CONTINUE LIT WITH BREAK CHAR.
L4.3: SOJ T3, ;DONT COUNT $
JUMPE T3,L4.4
IDIVI T3,5
AOJ T3,
MOVE T1,ENDLOC ;GET 1ST FREE LOC
MOVE T4,LOC ;GET LOC OF TYPE OPCODE
ADD T4,PROGRM ;ADD OFFSET
HRRM T1,(T4) ;PLUG IN ADDRESS
ADDM T3,ENDLOC
PUSHJ P,CHKEND
AOS LOC
L4.4: PUSHJ P,SRCTAB ;SEE IF TAG DEFINED
JRST L5 ;NO, REALLY A LITERAL
AOJ T1,
MOVE T2,SYMTAB(T1) ;GET ADDRESS
MOVE W,T1 ;SAVE T1
MOVE T1,LOC
ADD T1,PROGRM
HRRM T2,(T1) ;STUFF
HLRZ T2,SYMTAB(W) ;GET FLAGS
CAIE T2,1 ;EXTERNAL?
JRST L4.5 ;NO-SKIP
MOVE T2,LOC ;WHERE LAST REFERENCED
HRRM T2,SYMTAB(W) ;RE-LINK GLOBAL SYMBOL REQUEST
HRRZ T2,(T1) ;GET ADDRESS STORED
JUMPN T2,L4.5 ;JUMP IF NOT END OF GLOBAL SYMBOL CHAIN
MOVE T2,(T1) ;END OF CHAIN
TLO T2,20 ;FLAG AS NON-RELOC.
MOVEM T2,(T1) ;REPLACE
L4.5: AOS LOC ;NEXT!
MOVE T2,ENDLOC
ADD T2,PROGRM
MOVE T1,[POINT 7,(T2)]
SETZ T3, ;CLEAR CHAR. COUNTER
JRST L1+1 ;ALREADY HAVE I FROM LTAG
L5: MOVE T1,LOC ;GET LOC
ADD T1,PROGRM ;PLUS OFFSET
MOVE T3,ENDLOC ;GET ENDLOC
HRRM T3,(T1) ;MAKE ADDRESS
ADD T3,PROGRM ;PLUS OFFSET
MOVE T1,[POINT 6,T2] ;POINTER FOR TAG
MOVE T4,[POINT 7,(T3)] ;POINTER FOR STORAGE
PUSH P,I ;SAVE CURRENT CHAR.
MOVEI I,"$" ;START WITH $
IDPB I,T4 ;STUFF
L5.5: TLNN T1,770000 ;END TAG?
JRST L6 ;YES
ILDB I,T1 ;GET BYTE FROM TAG
JUMPE I,L6 ;NULL = END OF TAG
ADDI I,40 ;TO ASCII
IDPB I,T4 ;STUFF
JRST L5.5
L6: POP P,I ;RESTORE I
MOVEI T1,2 ;TAG TOOK UP 1 OR 2 WORDS
ADDM T1,ENDLOC ;SO SAY 2 AND DONT CARE IF WRONG
JRST L4.5 ;SET POINTERS AS IF REAL TAG
TLINE: TRZN F,FR.SUP ;SUPRESSING CRLF'S?
JRST .+4 ;NO, STUFF 'EM
SOJ T3, ;YES, DECREMENT COUNT
PUSHJ P,INCH ;EAT LF
JRST TL1 ;& SKIP
IDPB I,T1 ;LOAD CR
PUSHJ P,INCH ;& GET LF
AOJ T3, ;UP COUNT
IDPB I,T1 ;STUFF LF
TL1: HRRZ T4,T1 ;GET REL. ADDR OF LIT
ADD T4,T2 ;GET FULL ADDRESS
ADDI T4,20 ;FOR INSURANCE
CAMG T4,.JBREL ;OVER K BOUNDARY?
JRST .+3 ;NO, SKIP
CORE T4, ;CORE
BOMB F.NCOR ;NO GOOD
TRNN F,FR.LST
AOS LINE ;NEW LINE
TRO F,FR.IGS!FR.NLC ;TURN ON LEADING SPACE SUPPRESS
PUSHJ P,INCH ;GET FIRST CHAR
CAIE I,CR ;BLANK?
JRST .+3 ;NO, SKIP
PUSHJ P,INCH ;EAT LF
JRST .-4 ;GET 1ST OF NEXT
CAIE I,COLON ;IF COLON, CONTINUE LITERAL
JRST .+3 ;ELSE SKIP OVER
TRZ F,FR.IGS!FR.NLC ;STOP IGNORING SPACES
JRST L0 ;GO ON WITH LIT.
JUMPE T3,SCAN2 ;JUMP IF NO LITERAL
IDIVI T3,5 ;GET WORDS USED
AOJ T3, ;ROUND UP TO EVEN WORD
MOVE T1,ENDLOC ;GET 1ST FREE LOC
MOVE T2,LOC ;GET LOC OF TYPE OPCODE
ADD T2,PROGRM ;ADD OFFSET
HRRM T1,(T2) ;PLUG IN ADDRESS
ADDM T3,ENDLOC ;MAKE NEW ENDLOC
PUSHJ P,CHKEND ;CHECK IF ENDLOC IS TOO BIG
AOS LOC ;NEXT INSTR.
JRST SCAN2 ;ALREADY HAVE FIRST CHAR.
TLIT: PUSHJ P,LTAG
JUMPE T2,[BOMB (F.NTAG)]
PUSHJ P,SRCTAB ;GET VALUE OF TAG
BOMB F.UNDF ;NO TAG
AOJ T1, ;TO ADDRESS
MOVE T2,SYMTAB(T1)
MOVE T1,LOC
ADD T1,PROGRM
HRRM T2,(T1)
JRST WASTE2 ;GO
ATTAB: "T"
1,,"B"
32,,"U"
12,,"D"
25,,"L"
6,,"R"
14,,"C"
ATTABL==.-ATTAB
SUBTTL ACCEPT COMMAND
ACCEPT: MOVE T1,[ACCPT.]
PUSHJ P,INCH ;GET ADDRESS IF ANY
CAIN I,DOLLAR ;LITERAL STORAGE?
TLO T1,40 ;STORAGE = AC1
CAIN I,"#" ;OR NUMERIC STORAGE?
TLO T1,100 ;AC2 = NUMERIC LIT
TLNN T1,140
JRST ACCPT1 ;NO TAGS
PUSHJ P,LODACC ;STORE OPCODE & REMEMBER TAG
CAIE I,COMMA ;END ON COMMA?
JRST ACCP1A ;NO, SEE IF EOL
MOVE T1,[JUMP] ;ARG OF ACCEPT UUO
PUSHJ P,INCH ;GET NEXT CHAR.
CAIE I,DOLLAR ;TAG?
CAIN I,"#" ;OR OTHER
SKIPA ;YES
BOMB F.NTAG ;COMMA BUT NO $
JRST .-11 ;LOOP
ACCP1A: CAIE I,CR ;DID WE END ON <CR>?
BOMB F.IDLM ;ILLEGAL DELIMITER IN STRING...
JRST WASTE ;EAT CR-LF
ACCPT1: PUSHJ P,STOREX ;STORE INSTR.
CAIE I,CR ;TEST FOR GARBAGE AFTER COLON
BOMB F.NTAG ;GARBAGE.
JRST WASTE ;WAS EOL.
ACEPT2: PUSHJ P,INCH ;GET 1ST CHAR.
CAIE I,DOLLAR ;TAG?
CAIN I,"#" ;..
SKIPA ;YES
JRST WASTE2 ;NO-DONE
PUSHJ P,L2TAG1 ;LOAD TAG
CAIE I,COMMA ;BREAK ON COMMA?
JRST WASTE2 ;NO-MUST BE <CR>
AOS LOC ;NEXT LOC
PUSHJ P,L2TAG ;LOAD 'NUTHER
JRST .-4 ;LOOP
ALINE: PUSHJ P,INCH ;GET 1ST CHAR. AFTER COLON
CAIE I,DOLLAR ;$$$$?
BOMB F.NTAG ;AL: MUST HAVE TAG
MOVE T1,[ACCPT. 3,] ;ACCEPT LINE UUO
PUSHJ P,LODACC ;LOAD UUO & SYMBOL TABLE
JRST WASTE ;FORGET REST
ALINE2: PUSHJ P,L2TAG ;LOAD THE STORAGE LOCATION.
JRST WASTE2 ;IGNORE REST
SUBTTL COMPUTE COMMAND
;I FORTHWITH APPOLOGISE FOR THE FOLLOWING CODE;
;IT IS ONLY THAT I KNOW NO BETTER.
COMPUT: SETZ LC, ;CLEAR TEMP ADDRESS REGISTER
JRST COMP1 ;GO COMPUTE
CY: MOVE LC,LOC ;INITIALIZE START ADDRESS LOC
STORE <JUMPE 1,0> ;CY: STARTS WITH JUMPE 1,
JRST COMP1 ;PROCEED
CN: MOVE LC,LOC ;WE START HERE
STORE <JUMPN 1,0> ;WITH A JUMPN 1,
COMP1: MOVE T1,[COMP.] ;COMPUTE UUO
PUSHJ P,LODACC ;GET DESTINATION
PUSHJ P,CMS ;EAT ANY SPACES
CAIE I,"(" ;INDEXED DESTINATION?
JRST CM2.5 ;NO
STORE <INDEX.> ;YES--STORE INDEX OPCODE
PUSHJ P,BREAK ;EAT UNTIL BREAK
CAIN I,")" ;BREAK ON MATCHING PAREN?
PUSHJ P,INCH ;YES-CHUCK IT
PUSHJ P,CMS ;EAT UP TO THE =
CM2.5: CAIE I,"=" ;SHOULD BREAK ON EQUALS
BOMB F.COMP ;BAD COMPUTE SYNTAX
MOVE T1,[JUMP] ;"VALUE" OPCODE
CM3: PUSHJ P,BREAK ;EAT UNTIL BREAK
CAIE I,CR ;EOL?
CAIN I,42 ;QUOTE?
JRST CM4
MOVSI T2,-CMPTBL ;TABLE LENGTH
HRRZ T3,CMPTAB(T2) ;GET CHAR
CAME I,T3 ;MATCH?
AOBJN T2,.-2 ;NO, LOOP
JUMPGE T2,CM3 ;JUST FALSE ALARM
PUSHJ P,STOREX ;STUFF OLD UUO
HLRZ T1,CMPTAB(T2) ;GET UUO ADDR
MOVE T1,(T1) ;GET UUO
JRST CM3 ;& LOOP
CMPTAB: [CPLUS.],,"+" ;PLUS
[CMIN.],,"-" ;MINUS
[CMULT.],,"*" ;MULT.
[CDIV.],,"/" ;DIVIDE
[INDEX.],,"(" ;INDEX OPERATOR
CMPTBL==.-CMPTAB
CM4: PUSHJ P,STOREX ;STUFF LAST OPCODE
STORE <JFCL> ;SAY END OF COMPUTE
JUMPE LC,.+4 ;IF C:, SKIP
ADD LC,PROGRM ;ADD OFFSET TO WHERE WE WERE
MOVE T1,LOC ;GET WHERE WE ARE NOW
HRRM T1,(LC) ;PUT PRESENT ADDRESS BACK AT THE JUMPX 1,
CAIE I,42 ;SKIP IF QUOTE
JRST WASTE ;T-T-T-THATS ALL FOLKS
CM4.5: PUSHJ P,INCH
CAIE I,42
CAIN I,CR ;POSSABLE ENDING CONDITION?
JRST .+2 ;YES
JRST CM4.5 ;NO-CHEW SOME MORE
PUSHJ P,INCH ;GET NEXT
CAIN I,42
JRST CM4.5 ;QUOTE QUOTE
CAIE I,LF ;EOL?
JRST WASTE ;NO-FINISHED ON SINGLE QUOTE
AOS LINE
TRO F,FR.IGS!FR.NLC
PUSHJ P,INCH
CAIN I,CR
JRST [PUSHJ P,INCH
JRST .-4]
CAIN I,COLON
JRST CM4.5
JRST SCAN2
CMX: CAIE I,"+"
CAIN I,"-"
POPJ P, ;IF + OR -
CAIE I,"*"
CAIN I,"/"
POPJ P, ;OR * OR /
CAIE I,"("
CAIN I,")"
POPJ P, ;( OR )
CAIE I,"&" ;OR &
AOS (P) ;(E) NONE OF THE ABOVE--SKIP RETURN
POPJ P,
CMS: CAIE I,SPACE ;GOT A SPACE?
CAIN I,TAB ;OR A TAB?
SKIPA ;YES
POPJ P, ;NO-RETURN
PUSHJ P,INCH ;GET ANOTHER
JRST CMS ;LOOP
CYN2: AOS LOC ;ACCOUNT FOR JUMPX 1,
COMP2: PUSHJ P,L2TAG1 ;LOAD DEST ADDRESS
HLLZ T2,SYMTAB+1(T1) ;GET FLAGS AND SUCH
TLNN T2,4 ;NUMERIC?
JRST COMP2A ;NO-SKIP
MOVSI T4,40 ;SET OFF AC 1
MOVE T3,LOC
ADD T3,PROGRM ;GET ADDRESS OF THE INSTRUCTION
HLLZ T2,1(T3) ;GET NEXT INSTR.
CAMN T2,[INDEX.] ;INDEXED?
IORM T4,1(T3) ;MAKE IT [INDEX. 1,] IF NUMERIC INDEX
COMP2A: PUSHJ P,CMS ;CHASE SPACES
AOS LOC ;& MOVE LOC POINTER
CAIE I,"(" ;INDEXED?
JRST COMP4 ;NO
PUSHJ P,L2TAG1 ;LOAD INDEX TAG
COMP3: CAIN I,")" ;IF BREAK ON ) --
PUSHJ P,INCH ;EAT IT
PUSHJ P,CMS
AOS LOC
COMP4: PUSHJ P,INCH ;GET ATOM
CAIN I,LF ;EOL?
JRST WASTE2 ;FINIS
PUSHJ P,CMS ;CHASE SPACES
PUSHJ P,CMX ;IS IT A FUNCTION?
BOMB F.COMP ;2 FUNCTIONS
MOVE T3,ENDLOC ;GET FIRST FREE LIT LOC
ADD T3,PROGRM ;ADD OFFSET
MOVE T1,[POINT 7,(T3)] ;POINTER TO ENDLOC
MOVE T4,[POINT 6,T2] ;POINTER TO TAG
CLEAR T2, ;CLEAR STORAGE
TRZ F,FR.IGS ;MIGHT BE A STRING
CAIN I,42 ;QUOTED STRING?
JRST CM9 ;SPECIAL CASE
CM5.5: IDPB I,T1 ;STUFF INTO ENDLOC
SUBI I,40 ;TO SIXBIT
IDPB I,T4 ;& INTO B
PUSHJ P,INCH ;NEXT
PUSHJ P,CMX ;BREAK?
JRST CM6
CAIE I,SPACE
CAIN I,CR
JRST CM6
TLNE T4,770000 ;6 CHARS?
JRST CM5.5 ;NONE OF THE ABOVE, GET ANOTHER
CM6: PUSH P,T1 ;SAVE A
PUSHJ P,SRCTAB
JRST CM7 ;UNDEFINED, ITS A LITERAL
POP P,W ;WASTE SAVED POINTER
AOJ T1,
MOVE T2,SYMTAB(T1) ;GET ADDRESS
MOVE W,T1 ;SAVE REGISTER
MOVE T1,LOC
ADD T1,PROGRM
HRRM T2,(T1) ;STUFF IN CORE
HLLZ T2,SYMTAB(W) ;GET FLAGS
TLNN T2,1 ;EXTERNAL?
JRST CM6.5 ;NO-SKIP
MOVE T2,LOC ;GET WHERE WE ARE
HRRM T2,SYMTAB(W) ;FOR GLOBAL CHAIN
HRRZ T2,(T1) ;GET ADDRESS
JUMPN T2,CM6.6 ;JUMP IF NOT END OF CHAIN
MOVSI T2,20 ;FLAG AS START OF CHAIN
IORM T2,(T1) ;PUT BACK
CM6.5: TLNN T2,4 ;NUMERIC?
JRST CM6.6 ;NO-SKIP
HLLZ T2,1(T1) ;GET NEXT OPCODE
MOVSI T4,40 ;SET UP FLAG
CAMN T2,[INDEX.] ;INDEX?
IORM T4,1(T1) ;YES MAKE INDEX. 1,
CM6.6: MOVE T1,ENDLOC
ADD T1,PROGRM
SETZM (T1) ;KILL WHAT HAS BEEN WRITTEN
SETZM (T3) ;+ REST IF ANY
JRST COMP3 ;& GET ANOTHER ATOM
CM7: MOVE T1,LOC
ADD T1,PROGRM
MOVE T2,ENDLOC
HRRM T2,(T1) ;STUFF ENDLOC
POP P,T1 ;RESTORE A
CM7.5: CAIN I,CR
JRST CM8
PUSHJ P,CMX
JRST CM8
IDPB I,T1
PUSHJ P,INCH
JRST CM7.5
CM8: SETZ T2,
IDPB T2,T1
TLNE T1,760000
JRST .-2
AOJ T3,
HRRZS T1
ADD T3,T1
SUB T3,PROGRM
MOVEM T3,ENDLOC
PUSHJ P,CHKEND
JRST COMP3
CM9: PUSHJ P,INCH ;GET CHARACTER
CAIE I,42 ;QUOTE?
JRST CM9.1 ;NO
PUSHJ P,INCH ;GET NEXT CHAR.
CAIE I,42 ;QUOTE QUOTE?
JRST CM9.8 ;NO-END OF STRING
CM9.1: CAIN I,CR ;EOL?
JRST CM9.2 ;YES
IDPB I,T1 ;STUFF
JRST CM9 ;LOOP
CM9.2: PUSHJ P,INCH ;EAT LF
TRNN F,FR.LST
AOS LINE
TRO F,FR.IGS!FR.NLC
PUSHJ P,INCH ;GET 1ST CHAR OF NEW LINE
CAIN I,CR ;BLANK LINE?
JRST CM9.2 ;TRY AGAIN
CAIE I,COLON ;CONTINUE?
JRST CM9.9 ;NO-MISSING END QUOTE
TRZ F,FR.IGS!FR.NLC
MOVEI I,CR
IDPB I,T1 ;FAKE UP <CR>
MOVEI I,LF
IDPB I,T1 ;AND <LF>
JRST CM9 ;LOOP
CM9.8: SETZ I, ;IF ENDED BY QUOTE ELSE AT OPCODE
CM9.9: SETZ T2, ;NULL
IDPB T2,T1
TLNE T1,760000
JRST .-2
MOVE T2,LOC
MOVE T4,ENDLOC
ADD T2,PROGRM
HRRM T4,(T2) ;STORE LOC OF LITERAL
AOJ T3, ;BUMP OLD ENDLOC
HRRZS T1 ;GET LENGTH OF LITERAL
ADD T3,T1 ;GET NEW ENDLOC
SUB T3,PROGRM ;RELATIVE ADDRESS
MOVEM T3,ENDLOC ;SAVE
PUSHJ P,CHKEND
AOS LOC ;FOR JFCL
JUMPE I,WASTE2 ;WASTE REST
AOS LOC
JRST SCAN2 ;WE ALREADY HAVE 1ST CHAR.
SUBTTL EXITS
EY: STORE <SKIPE 1>
JRST EX
EN: STORE <SKIPN 1>
EX: STORE <EXIT.> ;EXIT UUO
JRST WASTE ;WASTE REST
EC: MOVE T1,[CALL.]
PUSHJ P,INCH
CAIE I,DOLLAR ;IN TAG?
JRST .+3 ;NO DO LITERAL
PUSHJ P,LODACC ;YES
JRST WASTE
PUSHJ P,STOREX
JRST WASTE
EL: STORE <LOG.>
JRST WASTE
EQ: STORE <QUIT.>
JRST WASTE
EYN2: AOS LOC
EXIT2: JRST WASTE2
EC2: PUSHJ P,INCH ;GET 1ST CHAR
CAIN I,DOLLAR ;IN STORAGE?
JRST EC2B ;YEP
MOVE T1,ENDLOC ;FIRST FREE
MOVE T2,LOC
AOS ENDLOC ;FOR SURE
AOS ENDLOC ;PROBABLY BE 5 OR 6 ANYWAY
ADD T2,PROGRM
HRRM T1,(T2) ;MOVE ENDLOC TO REAL CORE
ADD T1,PROGRM
MOVE T2,[POINT 7,(T1)]
SETZ T3,
SKIPA ;ALREADY HAVE 1ST CHAR.
EC2A: PUSHJ P,INCH
CAIE I,"." ;IN CASE SOMEONE GETS CUTE..
CAIN I,CR ;EOL?
JRST WASTE2
CAIGE T3,6 ;JUST 6
IDPB I,T2 ;STUFF LITERALLY
AOJA T3,EC2A ;COUNT & LOOP
EC2B: PUSHJ P,L2TAG1 ;LOAD ADDRESS
JRST WASTE2 ;AND EXIT
SUBTTL GET, PUT, STRING, & UNSTRING
STR: SKIPA T1,[STRN.] ;'STRING' OPCODE
UNSTR: MOVE T1,[UNSTR.] ;'UNSTRING' OPCODE
JRST PUTIT+1
GETIT: SKIPA T1,[GET.] ;GET THE OPCODE FOR LODACC
PUTIT: MOVE T1,[PUT.] ;'PUT' OPCODE
PUSHJ P,GETNUM ;GET CHANNEL # IF ANY
JUMPE T2,.+2 ;JUMP IF NO CHANNEL
DPB T2,[POINT 4,T1,12] ;STORE CHANNEL #
CAIE I,DOLLAR ;MUST BE TO STORAGE
BOMB F.NTAG ;YOU LOSE.
PUSHJ P,LODACC ;LOAD THE SYMBOL & OPCODE
CAIE I,COMMA ;BREAK ON COMMA?
JRST GET1A ;NO-SHOULD BE EOL
MOVE T1,[JUMP] ;ARG OPCODE
PUSHJ P,INCH ;GET NEXT CHARACTER
JRST .-7 ;LOOP
GET1A: CAIE I,CR ;END ON CR?
BOMB F.IDLM ;NO, HOLLER
JRST WASTE ;YES.
GY: STORE <SKIPE 1> ;CONDITIONAL. START WITH A SKIP
JRST GETIT
GN: STORE <SKIPN 1>
JRST GETIT
PY: STORE <SKIPE 1>
JRST PUTIT
PN: STORE <SKIPN 1>
JRST PUTIT
GC: MOVE T1,[GETC.] ;GET CONNECT UUO
JRST PUTIT+1
GR: MOVE T1,[GETR.] ;GR UUO
JRST PUTIT+1
GD: MOVE T1,[GETD.]
JRST PUTIT+1
GT: MOVE T1,[GETT.]
JRST PUTIT+1
GL: MOVE T1,[GETL.]
JRST PUTIT+1
GYN2: AOS LOC ;BUMP OVER THE SKIPX
GET2: PUSHJ P,GETNUM ;EAT CHANNEL #
PUSHJ P,L2TAG+1 ;LOAD TAG ADDRESS
CAIE I,COMMA ;BREAK ON COMMA?
JRST WASTE2 ;NO. DONE.
AOS LOC ;YES, NEXT LOC
JRST GET2 ;& RETURN
SUBTTL OPENS
OPENIN: SKIPA T1,[IN.] ;OPEN-LOOKUP
OPENOT: MOVE T1,[OUT.] ;OPEN-ENTER
PUSHJ P,GETNUM ;GET CHANNEL # IN T2
DPB T2,[POINT 4,T1,12] ;STORE CHANNEL
CAIE I,DOLLAR ;IN TAG?
JRST .+3 ;NO, LITERAL
PUSHJ P,LODACC ;LOAD SYMBOL AND INSTR.
JRST WASTE ;& WASTE REST
PUSHJ P,STOREX ;JUST LOAD OPCODE-LIT ADDR ON PASS2
JRST WASTE ;THERE IS ONLY 1 ARG.
OPEN2: PUSHJ P,GETNUM ;EAT CHANNEL #
CAIN I,DOLLAR ;TAG?
JRST OPEN2A ;YES
MOVE T1,ENDLOC ;FIRST FREE
MOVEI T2,2 ;CAN USE UP 2 WORDS MAX.
ADDM T2,ENDLOC ;BUMP ENDLOC BY 2
MOVE T2,LOC ;WHERE WE ARE
ADD T2,PROGRM ;PLUS ABS. ADDR. OFFSET
HRRM T1,(T2) ;PLUG IN ADDRESS FOR THE OPCODE
ADD T1,PROGRM ;NOW TO REAL CORE
MOVE T2,[POINT 7,(T1)];LOAD IT AS YOU SEE IT
SKIPA ;ALREADY HAVE 1ST CHAR.
OPN2: PUSHJ P,INCH ;GET CHAR.
CAIN I,CR ;IF <CR>--
JRST WASTE2 ;FINIS
IDPB I,T2 ;STUFF CHAR. INTO LITERAL
JRST OPN2 ;LOOP
OPEN2A: PUSHJ P,L2TAG1 ;STORE TAG LOCATION
JRST WASTE2 ;THATS ALL FOLKS
SUBTTL TRAP
TRAPIT: STORE <TRAP.> ;TRAP UUO
JRST WASTE ;REST IS ON PASS 2
TRAPY: STORE <SKIPE 1> ;CONDITIONAL TRAP
JRST TRAPIT ;& STORE OPCODE
TRAPN: STORE <SKIPN 1> ;..
JRST TRAPIT ;..
TRPYN2: AOS LOC ;BUMP OVER THE SKIPX
TRAP2: MOVE T1,ENDLOC ;FIRST FREE LOC
MOVE T2,LOC ;LOC OF INSTR
ADD T2,PROGRM ;ABS LOC OF INSTR
HRRM T1,(T2) ;ADDR. OF TRAP INSTR. IS ENDLOC
ADD T1,PROGRM ;NOW TO ABS FOR LIT.
MOVE T2,[4,,400040] ;TRAP ADDRESS
MOVEM T2,(T1) ;STORE
MOVEI T2,2 ;^C TRAP
MOVEM T2,1(T1) ;INTO ENDLOC+1
SETZ T2, ;CLEAR THE REMAINDER
MOVEM T2,2(T1) ;OF THE TRAP BLOCK
MOVEM T2,3(T1) ;..
MOVEI T3,4 ;USED 4 LOCATIONS
ADDM T3,ENDLOC ;UPDATE ENDLOC
PUSHJ P,CHKEND ;SEE IF GOING TO VIOLATE MEMORY
JRST WASTE2 ;WASTE REST
SUBTTL MATCH
ME: SKIPA T1,[MATX.] ;MATCH EXACT UUO
MATCH: MOVE T1,[MATCH.] ;MATCH UUO
PUSHJ P,INCH ;GET CHAR
CAIN I,DOLLAR ;MATCH AGAINST TAG?
JRST NMATCH ;YES, THEN ITS NUMERIC MATCH TIME.
PUSHJ P,STOREX ;NO--JUST STORE OPCODE
JRST M0+1 ;AND GET REST OF LINE.
M3.5: PUSHJ P,INCH
MOVE T1,[JUMP] ;OPCODE
CAIE I,DOLLAR
JRST M0+1
PUSHJ P,LODACC
JRST WASTE ;NUMERIC MATCHS ARE ONE (MATCH) ARG
MA1: PUSHJ P,STOREX
JRST M0+1
MA2: STORE <JUMP> ;ARG
M0: PUSHJ P,INCH ;GET CHAR.
CAIN I,LF ;EOL?
JRST TMLINE ;TEST NEXT LINE FOR CONTINUE
CAIN I,COMMA ;DELIMITER?
JRST MA2 ;DO THINGS
CAIN I,CR ;<CR>?
JRST MA2 ;DOIT ALSO
JRST M0 ;LOOP FOR BREAK
ML: MOVE T3,[MATL.]
MOVE T4,[NMATL.]
JRST .+3
MG: MOVE T3,[MATG.]
MOVE T4,[NMATG.]
MOVE T1,T3
PUSHJ P,INCH
CAIE I,DOLLAR
JRST MA1
MOVE T1,T4
PUSHJ P,LODACC
CAIN I,COMMA
JRST M3.5
JRST NM1
TMLINE: AOS LINE ;NEWLINE
TRO F,FR.IGS!FR.NLC
PUSHJ P,INCH ;GET 1ST CHAR
CAIN I,CR
JRST TMLINE
CAIE I,COLON ;CONTINUATION?
JRST SCAN2 ;NO, PARSE AS NEW LINE
TRZ F,FR.IGS!FR.NLC ;STOP IGNORING SPACES
JRST M0 ;& LOOP
NMATCH: MOVE T1,[NMAT.]
PUSHJ P,LODACC ;LOAD TAG
CAIN I,COMMA ;BREAK ON COMMA?
JRST M3.5 ;& TREAT AS ANY OTHER MATCH
MOVE T3,[MATX.]
NM1: MOVE T1,LOC
ADD T1,PROGRM
SOJ T1,
MOVEM T3,(T1)
AOJ T1,
MOVE T2,[JUMP]
MOVEM T2,(T1)
AOS LOC
JRST WASTE
MATCH2: TRZ F,FR.IGS ;ON YOUR TOES...
PUSHJ P,INCH ;THIS IS ALL SIGNIF.
CAIE I,DOLLAR ;TAG?
JRST M00 ;NO, SKIP
PUSHJ P,L2TAG1 ;LOAD TAG ADDRESS
CAIE I,COMMA ;BREAK ON COMMA?
JRST M4 ;OH-OH, FIXUP
PUSHJ P,INCH ;ONWARD & UPWARD
CAIE I,DOLLAR ;'NOTHER TAG??
JRST M00 ;NO, WE GOT A LIT.
AOS LOC ;BUMP FOR NEXT ADDRESS STUFF
PUSHJ P,L2TAG1 ;STUFF AWAY!!
JRST WASTE2 ;ONLY 1 TAG MATCH ALLOWED
M00: AOS LOC ;NEXT LOC
MOVE T2,ENDLOC
ADD T2,PROGRM
MOVE T1,[POINT 7,(T2)] ;POINTER TO ENDLOC
SETZB T3,T4
M2: CAIN I,LF ;EOL?
JRST TMLIN1 ;TEST NEXT LINE FOR CONT.
CAIN I,COMMA
JRST M3 ;BUNDLE IT UP
CAIN I,CR ;OR <CR>?
JRST M3 ;JUST AS GOOD
IDPB I,T1 ;STUFF IT
PUSHJ P,INCH
AOJA T3,M2 ;BUMP COUNT & LOOP
M3: IDIVI T3,5 ;GET WORDS
AOJ T3, ;UP FOR ASCIZ
MOVE T1,ENDLOC ;GET ENDLOC
MOVE T2,LOC
ADD T2,PROGRM
HRRM T1,(T2) ;MOVE POINTER
ADDM T3,ENDLOC ;UPDATE ENDLOC
PUSHJ P,CHKEND ;SEE IF OVER K BOUNDARY
PUSHJ P,INCH ;I KNOW..
JRST M00 ;LOOP FOR ALL MATCH CHARS.
M4: MOVE T1,LOC
ADD T1,PROGRM
MOVE T2,(T1) ;GET IT
HLLZM T2,(T1) ;RESTORE OPCODE ONLY
AOJ T1, ;NEXT
HRRM T2,(T1) ;REPLACE ADDRESS
AOS LOC
JRST WASTE2
TMLIN1: TRO F,FR.IGS!FR.NLC ;IGNORE LEADING SPACES & LC
PUSHJ P,INCH ;IF EOF WILL FALL THRU TO SCAN2
CAIE I,COLON ;CONTINUE?
JRST .+4 ;NO, SKIP
TRZ F,FR.IGS!FR.NLC
PUSHJ P,INCH ;GET NEXT CHAR
JRST M00+1 ;BACK FOR MORE PUNISHMENT
CAIN I,CR ;IF BLANK..
JRST TMLIN1 ;TEST NEXT LINE.
TRNN F,FR.LST ;IF WE AREN'T LISTING..
AOS LINE ;BUMP LINE
JRST SCAN2 ;& GO.
SUBTTL JUMP
JY: STORE <SKIPE 1> ;JUMP ONLY IF AC1 NOT 0
JRST JMP
JN: STORE <SKIPN 1> ;THE OTHER WAY AROUND.
JMP: MOVE T4,[JRST 0] ;J: = JRST
PUSHJ P,INCH ;GET TAG OR SWITCH
CAIN I,DOLLAR ;COMPUTE JUMP?
JRST .+3 ;YES, GO DOIT
PUSHJ P,L1TAG+1 ;LOAD THE TAG
JRST WASTE ;DONT NEED ANY MORE
MOVE T1,[CJUMP.] ;COMPUTED JUMP OPCODE
PUSHJ P,LODACC ;LOAD SYMBOL & OPCODE
CAIE I,COMMA ;BREAK ON COMMA?
JRST WASTE ;NO, WE'RE DONE.
MOVE T4,[JUMP] ;YES--PUT IN A FILLER OPCODE
PUSHJ P,L1TAG ;LOAD THE NEXT TAG
JRST .-4 ;LOOP
JYN2: AOS LOC ;BUMP OVER SKIPX
JMP2: PUSHJ P,L2TAG ;LOAD THE TAG ADDRESS
CAIE I,COMMA ;BREAK ON COMMA?
JRST WASTE2 ;NO--DONE.
AOS LOC ;YES--NEXT LOC
JRST .-4 ;LOOP
SUBTTL SUBROUTINE CALL
GOSBY: STORE <SKIPE 1> ;CONDITIONAL GOSUB
JRST GOSUB
GOSBN: STORE <SKIPN 1> ;THE OTHER CONDITIONAL
GOSUB: MOVE T4,[PUSHJ 17,0] ;U: = PUSHJ 17,
PUSHJ P,INCH ;GET 1ST CHAR.
CAIN I,DOLLAR ;COMPUTED GOSUB?
JRST .+3 ;YES--SKIP
PUSHJ P,L1TAG+1 ;NO, LOAD ADDRESS
JRST WASTE ;AND WASTE REST
MOVE T1,[CPUSH.] ;GET OPCODE
PUSHJ P,LODACC ;LOAD OPCODE & SYMBOL
CAIE I,COMMA ;ANOTHER TAG?
JRST WASTE ;NO--DONE
MOVE T4,[JUMP] ;GET FILLER OPCODE
PUSHJ P,L1TAG ;LOAD IT TOO
JRST .-4 ;LOOP
GOYN2: AOS LOC ;BUMP OVER SKIPX
GOSUB2: PUSHJ P,L2TAG ;LOAD TAG ADDRESS
CAIE I,COMMA ;ANY MORE?
JRST WASTE2 ;NO
AOS LOC ;YES. NEXT LOC
JRST GOSUB2 ;LOOP
SUBTTL EXTERNAL SUBROUTINE LINKAGE
LINKY: STORE <SKIPE 1> ;CONDITIONAL LINK
JRST LINK
LINKN: STORE <SKIPN 1>
LINK: TRO F,FR.GLB ;SAY I'M A GLOBAL SYMBOL
MOVE T1,[PUSHJ 17,0] ;STANDARD CALL
PUSHJ P,LODACC ;DOIT
LN2: CAIE I,COMMA ;BREAK ON COMMA?
JRST LNK1 ;NO, SEE IF EOL
PUSHJ P,DTAG ;GET SYMBOL
TRO FR.IGS ;IGNORE SPACES AGAIN
PUSHJ P,INTER ;RENDER IT INTERNAL
JRST LN2 ;LOOP
LNK1: CAIE I,CR ;EOL?
BOMB F.IDLM ;NO, FUNNY BREAK
JRST WASTE ;YES, EAT LF
LYN2: AOS LOC
LINK2: JRST WASTE2 ;WASTE IT
ENTRYP: TRO F,FR.END ;THIS PROGRAM IS AN EXTERNAL SUBROUTINE
;THEREFORE IT HAS NO START ADDRESS
;SO BE IT.
PUSHJ P,LTAG ;GET ENTRY POINT
TRO F,FR.IGS
PUSHJ P,INTER ;MAKE INTERNAL
MOVE T2,LOC ;GET "HERE"
HRRM T2,SYMTAB+1(T1) ;SAVE IT
ENTP1: CAIE I,COMMA ;BREAK ON COMMA?
JRST LNK1 ;NO, SEE IF EOL
PUSHJ P,DTAG ;GET TAG
TRO F,FR.IGS ;TURN BACK ON FLAG
PUSHJ P,EXTER ;RENDER IT EXTERNAL
JRST ENTP1 ;LOOP
SUBTTL DIMENSION STATEMENT
; OUTPUT OF THE STATEMENT "D:$TAG(LEN)" IS:
;
;
; SYMTAB: SIXBIT /TAG/
; BYTE (12) LEN,BYTE (6) 0,,ADDRESS
;
;
DIMENS: PUSHJ P,DTAG ;LOAD TAG IN T2
TRO F,FR.IGS ;TURN BACK ON IGS FLAG
PUSHJ P,SRCTAB ;SEARCH SYMBOL TABLE
MOVEM T2,SYMTAB(T1) ;STUFF SYMBOL
SETZ T3, ;CLEAR TOTAL
CAIE I,"(" ;BREAK ON LEFT PAREN?
BOMB F.COMP ;THAT'LL SHAKE 'EM UP
DNL: PUSHJ P,INCH ;GET NUMBER
CAIG I,"9" ;> 9?
CAIGE I,"0" ;>=0?
JRST DIX ;BREAK
IMULI T3,12 ;DECIMAL SHIFT
ADDI T3,-60(I) ;ADD NUMBER TO TOTAL
JRST DNL ;DIM. NUM. LOOP
DIX: LSH T3,^D24 ;SHIFT AWAY FROM INT/EXT BITS
MOVE T2,SYMTAB+1(T1) ;GET ADDRESS WORD
IORM T3,T2 ;SNEAK IN THE NUMBER
MOVEM T2,SYMTAB+1(T1) ;SO THAT THE FLAGS AREN'T DISTURBED
CAIN I,")" ;BREAK ON PAREN?
PUSHJ P,INCH ;GET NEXT
CAIN I,COMMA ;BREAK ON COMMA?
JRST DIMENS ;YES, START OVER
CAIN I,CR ;ON EOL?
JRST WASTE ;YES, DONE
BOMB F.IDLM ;NOT COMMA OR EOL-BAD SYNTAX
;HERE TO RENDER A VARIABLE NUMERIC ONLY
NUMX: PUSHJ P,DTAG ;GET TAG
TRO F,FR.IGS
PUSHJ P,NUMRIC ;ENTER IT AS NUMERIC ONLY
CAIN I,COMMA ;COMMA?
JRST NUMX ;YES, DOIT AGAIN
CAIE I,CR ;LEGAL EOL?
BOMB F.IDLM ;NO-HOLLER
JRST WASTE ;YES-FINISH LINE
SUBTTL I-O ROUTINES
INCH: TLNE BUFPTR,760000 ;ALL CHARS OUT OF WORD?
JRST INCH1 ;NO
PUSHJ P,INCHL
JRST INCH1
INCHL: PUSHJ P,INCHX ;GET WORD
TRNN BUF,1 ;LINE NUMBER?
JRST INCHL1 ;NO
TLNE BUF,770000 ;FUNNY?
MOVEM BUF,EDLINE ;SAVE IT
JRST INCHL ;YES
INCHL1: MOVE BUFPTR,[POINT 7,BUF]
POPJ P,
INCHX: SOSGE IBUF+2
JRST .+3
ILDB BUF,IBUF+1
POPJ P,
IN IN,
JRST INCHX
TRO F,FR.EOF ;SAY WE'RE A WALKING DEAD
SETZ BUF, ;CLEAR MINI BUFFER
POPJ P, ;RETURN
EOF: CLOSE IN, ;CLOSE INPUT FILE
TRZ F,FR.EOF ;AND CLEAR EOF FLAG
TRNN F,FR.P2 ;PASS 2 DONE?
JRST STRTP2 ;NO, START PASS 2
PUSHJ P,TTYEND ;TYPE ERRORS DETECTED
TRNN F,FR.LST ;LISTING?
JRST LODREL ;NO--GO ON
PUSHJ P,LSTCOR ;TELL HOW MUCH CORE USED
CLOSE LST, ;CLOSE LIST FILE
JRST LODREL ;LOAD REL FILE
INCH1: ILDB I,BUFPTR
TRNN F,FR.EOF ;SKIP IF EOF
JUMPE I,INCH ;DON'T LET NULLS GET THROUGH
CAIE I,FF ;OR FORM FEEDS
CAIN I,VT ;OR VERTICAL TABS
JRST INCH ;..
CAIE I,LF ;BREAK?
JRST .+3 ;NO, SKIP
TRNE F,FR.P2 ;AND PASS 2?
PUSHJ P,TTYBIT ;DO THE TTY BIT
TRNE F,FR.LST ;LISTING?
TRNN F,FR.P2 ;AND ON PASS2?
JRST NOLST ;NO--DON'T LIST
CAIE I,LF ;END OF LINE?
JRST .+3 ;NO--SKIP
PUSHJ P,LINEIT ;YES--DO END OF LINE STUFF
SKIPA I,[LF] ;RELOAD LF & SKIP
PUSHJ P,LOUCH ;OUTPUT CHARACTER
NOLST: TRNN F,FR.NLC ;LOWER CASE ENABLED?
JRST .+3 ;YES--SKIP
CAIL I,140 ;LOWER CASE?
SUBI I,40 ;CONVERT TO UPPER CASE
CAIE I,SPACE ;SPACE?
CAIN I,TAB ;TAB?
TRNN F,FR.IGS ;IGNORE SPACES & TABS?
POPJ P, ;NOT SPACE OR TAB-OR THEY ARE ALLOWED
JRST INCH ;YES, GET ANOTHER ONE
LOUCH: SOSGE LSTBUF+2
JRST .+3
IDPB I,LSTBUF+1
POPJ P,
OUTPUT LST,
JRST LOUCH
SUBTTL LISTING ROUTINES
LINEIT: PUSHJ P,LOUCH ;DO LF
MOVSI P1,-100 ;LENGTH OF TABLE
HLRZ P2,PASS1B(P1) ;GET 1ST LINE #
JUMPE P2,NOP1ER ;JUMP IF NO ERRORS
CAME P2,LINE ;RIGHT TIME?
AOBJN P1,.-3 ;NO, GET NEXT ONE
JUMPGE P1,NOP1ER ;JUMP IF THE IMPROBABLE HAPPENS
HRRZ P2,PASS1B(P1) ;GET ADDRESS
CAME P2,P3 ;SAME ERROR TWICE?
PUSHJ P,ERRIT ;NO, DO PASS 1 ERROR
NOP1ER: JUMPE P3,NOERR ;JUMP IF NOERROR
MOVE P2,P3 ;STANDARDIZE
PUSHJ P,ERRIT ;DO PASS2 ERROR
NOERR: MOVE P1,LINCNT ;GET LINE COUNT
CAIL P1,PAGSIZ ;MAX LINES?
PUSHJ P,HEDDR1 ;YES--NEW PAGE BUT NOT NEW PAGE #
AOS LINE ;NEW LINE
TLNN BUFPTR,760000 ;CAN WE LOOK AHEAD?
PUSHJ P,INCHL ;NO, FORCE NEW WORD
TRNE F,FR.EOF ;EOF??
POPJ P, ;YES--BAIL OUT.
MOVE P2,BUFPTR ;SAVE BYTE POINTER
ILDB P1,P2 ;THIS IS JUST A SNEAKY LOOK
JUMPE P1,NOLINE ;HIT A NULL, MAKE SURE EOF
CAIE P1,FF ;FORM FEED?
CAIN P1,VT ;OR VERTICAL TAB?
JRST NEWPAG ;YES, CELEBRATE NEW PAGE
DOLINE: MOVEI P1,TABLIN ;OUTPUT A TAB
PUSHJ P,LSTSTR ;..
PUSHJ P,LINUM ;DO LINE NUMBER
MOVEI P1,TABLIN ;'NUTHER TAB
SETZ P3, ;NO MORE
JRST LSTSTR ;PJRST
NOLINE: PUSHJ P,INCHL ;LOAD MINI-BUFFER
JRST NOERR+4 ;BACK TO TEST
NEWPAG: SETZM SUBPAG ;NEW PAGE = ZERO SUBPAGE
AOS PAGE ;NEXT PAGE
PUSHJ P,HEDDER ;DO THE HEADER
JRST DOLINE ;AND START THE NEXT LINE
ERRIT: AOS ERRORS ;COUNT THE ERROR
MOVEI P1,CRLF
PUSHJ P,LSTSTR
AOS LINCNT
MOVEI P1,[ASCIZ/******* /]
PUSHJ P,LSTSTR
MOVE P1,P2 ;TRANSFER ERROR
PUSHJ P,LSTSTR
MOVEI P1,CRLF ;CAP IT
PUSHJ P,LSTSTR
AOS LINCNT
AOS LINCNT
JRST LSTSTR
LINUM: AOS LINCNT
SKIPE EDLINE ;SEE IF SOS LEFT US ANYTHING
JRST DMPLIN ;YES, JUST DUMP LINE
MOVE P2,LINE
DECOUT: SKIPA P1,[12]
OCTOUT: MOVEI P1,10
LSTNUM: IDIV P2,P1
JUMPE P2,.+4
PUSH P,P3
PUSHJ P,LSTNUM
POP P,P3
MOVEI I,60(P3)
JRST LOUCH
DMPLIN: MOVEI P1,EDLINE
JRST LSTSTR
TTYBIT: MOVSI P1,-100 ;LENGTH OF TABLE
HLRZ P2,PASS1B(P1) ;GET LINE #
JUMPE P2,TNOBIT ;NO COMPLAINTS AT ALL
CAME P2,LINE ;RIGHT LINE?
AOBJN P1,.-3 ;NO,LOOP
JUMPGE P1,TNOBIT ;JUMP IF RAN OUT
HRRZ P2,PASS1B(P1) ;GET ADDRESS OF ERROR
CAME P2,P3 ;SAME AS THIS ONE?
PUSHJ P,TTYERR ;NO, DO PASS1 ERROR
TNOBIT: JUMPE P3,TTYERX ;SKIP IF NO ERROR
MOVE P2,P3
PUSHJ P,TTYERR ;DO ERROR
TRNN F,FR.LST ;IF NOT LISTING,
SETZB P2,P3 ;NO MORE
TTYERX: POPJ P,
TTYERR: TRNE F,FR.TTY ;SUPPOSED TO HOLLER?
POPJ P, ;NO
PUSHJ P,LINER ;YES--DO LINE NUMBER
OUTCHR [TAB] ;-A TAB-
OUTSTR (P2) ;THE NOISE.
OUTSTR CRLF ;<CR><LF>
POPJ P, ;& RETURN
TTYEND: SKIPN T1,ERRORS ;GET ERRORS
POPJ P, ;IF NO ERRORS DO NOTHING
OUTSTR [ASCIZ/
? /] ;OUTPUT SEPERATOR
MOVE T2,T1 ;SAVE # ERRORS
PUSHJ P,TTYNUM ;TYPE ERRORS
OUTSTR [ASCIZ/ ERROR/] ;TEXT
CAIE T1,1 ;SINGULAR?
OUTCHR ["S"] ;NO--PLURAL
OUTSTR [ASCIZ/ DETECTED
/]
POPJ P, ;RETURN
LSTCOR: MOVE T1,LINCNT ;GET LINE COUNT
CAILE T1,^D50 ;IF OVER 50
PUSHJ P,HEDDR1 ;GO TO NEXT PAGE WITH SAME PAGE NUMBER
MOVE T1,LINCNT ;(IN CASE HEDDER DONE)
SUBI T1,5 ;SUBTRACT 5 LINES
MOVEM T1,LINCNT ;RESTORE
MOVEI P1,CRLF ;NEXT LINE
PUSHJ P,LSTSTR
SKIPN T1,ERRORS ;SKIP IF ERRORS
JRST NOERRM ;NO ERRORS
MOVE P2,T1 ;GET ERRORS
PUSHJ P,DECOUT ;OUTPUT
MOVEI P1,[ASCIZ/ ERROR/]
PUSHJ P,LSTSTR ;OUTPUT ERROR
MOVEI I,"S" ;READY FOR PLURAL
CAIE T1,1 ;ONLY ONE ERROR?
PUSHJ P,LOUCH ;NO--OUTPUT "S"
MOVEI P1,[ASCIZ/ DETECTED
/]
PUSHJ P,LSTSTR ;OUTPUT REST OF LINE
LCORE1: MOVE P2,ENDLOC ;GET LAST LOCATION
PUSHJ P,DECOUT ;HOW MANY WORDS USED (DECIMAL)
MOVEI P1,[ASCIZ / (/]
PUSHJ P,LSTSTR
MOVE P2,ENDLOC
PUSHJ P,OCTOUT ;HOW MANY WORDS USED (OCTAL)
MOVEI P1,[ASCIZ/ OCTAL) WORDS USED
/]
PUSHJ P,LSTSTR ;OUTPUT
SETZ T1, ;ZERO MEANS ME
RUNTIM T1, ;GET RUNTIM
SUB T1,STRTIM ;MINUS START TIME
IDIVI T1,^D1000 ;GET SECONDS
MOVE P2,T1 ;GET SECONDS FOR OUTPUT
PUSHJ P,DECOUT ;OUTPUT
MOVEI I,"." ;DECIMAL POINT
PUSHJ P,LOUCH
REPEAT 3,<
IDIVI T2,^D10
PUSH P,T3
>
REPEAT 3,<
POP P,T3
MOVEI I,60(T3)
PUSHJ P,LOUCH
>
MOVEI P1,[ASCIZ/ CPU SECONDS USED
/]
PUSHJ P,LSTSTR ;OUTPUT
MOVE P2,.JBFF ;TOP OF CORE
ADD P2,ENDLOC ;PLUS PROGRAM
SUBI P2,ENDLOW ;MINUS TOP OF LOWSEG
ADDI P2,2000 ;PLUS 1K
LSH P2,-12 ;DIVIDE BY 2000
PUSHJ P,DECOUT ;OUTPUT CORE USED
MOVEI P1,[ASCIZ/K CORE USED
/]
PUSHJ P,LSTSTR ;TYPE IT
TRNN F,FR.MAP ;MAP WANTED?
POPJ P, ;NO
SETZ T1, ;INIT XR
MOVEI P1,[ASCIZ/
SYMBOL MAP
/]
PUSHJ P,LSTSTR
LSTMAP: MOVE T3,LINCNT ;GET LINES PRINTED
CAILE T3,^D55 ;OVER 55?
PUSHJ P,HEDDR1 ;NEW PAGE
MOVE T2,SYMTAB(T1) ;GET SYMBOL
JUMPE T2,LSTLIT ;END
MOVEI I,TAB ;TAB
PUSHJ P,LOUCH
PUSHJ P,SIXOUT ;TYPE SYMBOL
MOVEI I,TAB ;- A TAB -
PUSHJ P,LOUCH ;..
AOJ T1, ;BUMP TO ADDRESS
HRRZ P2,SYMTAB(T1) ;GET ADDRESS
PUSHJ P,OCTOUT ;TYPE IT
HLLZ T2,SYMTAB(T1) ;GET TYPE
JUMPE T2,NOTYPE ;NO TYPE
TLNN T2,1 ;EXTERNAL?
JRST .+3 ;NO
MOVEI P1,[ASCIZ/ EXTERNAL/]
PUSHJ P,LSTSTR
TLNN T2,2 ;INTERNAL?
JRST .+3 ;NO (??)
MOVEI P1,[ASCIZ/ INTERNAL/]
PUSHJ P,LSTSTR
LDB P2,[POINT 12,T2,11] ;GET DIM. LENGTH
JUMPE P2,NOTYPE ;NOT DIM.
MOVEI P1,[ASCIZ/ DIMENSION /]
PUSHJ P,LSTSTR ;TYPE
PUSHJ P,DECOUT ;AND NUMBER
NOTYPE: MOVEI P1,CRLF ;NEWLINE
PUSHJ P,LSTSTR
SOS LINCNT ;DECREMENT LINECOUNT
AOJA T1,LSTMAP ;LOOP
LSTLIT: MOVEI P1,[ASCIZ/
LITERALS START AT /]
PUSHJ P,LSTSTR
MOVE P2,LITLOC
SUB P2,PROGRM
PUSHJ P,DECOUT
MOVEI P1,[ASCIZ/ (/]
PUSHJ P,LSTSTR
MOVE P2,LITLOC
SUB P2,PROGRM ;TO RELATIVE LOC
PUSHJ P,OCTOUT
MOVEI P1,[ASCIZ/)
/]
PJRST LSTSTR
SIXOUT: MOVE T3,[POINT 6,T2]
TLNN T3,770000 ;ALL DONE?
CPOPJ: POPJ P, ;YES
ILDB I,T3 ;GET CHAR
JUMPE I,CPOPJ ;IF NULL, FINI.
ADDI I,40 ;TO ASCII
PUSHJ P,LOUCH ;OUTPUT
JRST SIXOUT+1 ;LOOP
LSTSTR: HRLI P1,440700
PUSH P,I
ILDB I,P1
JUMPE I,.+3
PUSHJ P,LOUCH
JRST .-3
POP P,I
POPJ P,
NOERRM: MOVEI P1,[ASCIZ/NO ERRORS DETECTED
/]
PUSHJ P,LSTSTR ;OUTPUT
JRST LCORE1 ;& DO REST
STRTP2: TRO F,FR.P2 ;ON PASS 2
STORE <JERK.> ;ALWAYS LAST INSTR
MOVE T1,LOC ;END OF OPCODES IS
MOVEM T1,ENDLOC ;START OF LITERALS
ADD T1,PROGRM ;TO ABS ADDRESS
MOVEM T1,LITLOC ;FOR RELOC
PUSHJ P,LODTAG ;START PASS2 FIXUPS
MOVE T1,FSTLOC ;FIRST GOOD LOCATION
MOVEM T1,LOC ;AFTER INIT.
SETZM LINE ;INITIALIZE LINE COUNT
SETZM EDLINE ;AND SOS LINE
LOOKUP IN,LOOKIT
BOMB F.DISS ;FILE DISAPPEARED
PUSHJ P,INCHL ;LOAD 1ST BUFFER IN CASE LINE #
TRNE F,FR.LST ;IF LISTING,
PUSHJ P,LINEIT ; DO WHATEVER LINE #
JRST SCANER ;RETURN TO SCANER
SUBTTL SUBROUTINES
;SUBROUTINE TO STORE AN OPCODE
;CALL WITH OPCODE IN T1
;INCREASES CORE IF NEEDED
;RESPECTS ALL AC'S
STOREX: PUSH P,T2 ;SAVE T2
MOVE T2,LOC ;GET CURRENT LOCATION
ADD T2,PROGRM ;ADD ABS. CORE OFFSET
PUSH P,T2 ;AND SAVE CORE LOC.
ADDI T2,10 ;FOR INSURANCE
CAMG T2,.JBREL ;ABOVE K BOUNDARY?
JRST NOCORE ;NEED NO CORE
CORE T2, ;GET CORE
BOMB F.NCOR
NOCORE: POP P,T2 ;RESTORE CORE LOC.
MOVEM T1,(T2) ;LOAD INTO PROGRAM STORAGE
AOS LOC
POP P,T2 ;REPLACE T2
POPJ P,
;SUBROUTINE TO CHECK IF ENDLOC HAS GONE OVER K BOUNDARY
;RESPECTS ALL AC'S
CHKEND: PUSH P,T3 ;SAVE IT
MOVE T3,PROGRM
ADD T3,ENDLOC
ADDI T3,20 ;+ UNTIL NEXT TEST
CAMLE T3,.JBREL
JRST [CORE T3,
BOMB F.NCOR
JRST .+1]
POP P,T3
POPJ P,
;SUBROUTINE TO SEARCH THE SYMBOL TABLE
;CALL WITH SYMBOL IN T2
;SKIP RETURN IF MATCH. T1 = INDEX
;RETURN IF NO MATCH. T1 = 1ST FREE INDEX
SRCTAB: SETZ T1,
SKIPN SYMTAB(T1) ;ENTRY EMPTY?
POPJ P, ;NO MATCH
CAME T2,SYMTAB(T1) ;MATCH?
JRST .+3 ;NO
AOS (P) ;YES
POPJ P,
ADDI T1,2 ;NEXT
CAIG T1,SYMAX ;OVERFLOW?
JRST SRCTAB+1 ;NO
BOMB F.SYOV ;YES
;WASTE REST OF LINE
PUSHJ P,INCH ;EAT! EAT!
WASTE: TRNE F,FR.EOF ;WALKING DEAD?
JRST EOF ;YES
CAIE I,LF ;VERY EOL?
JRST WASTE-1 ;NO--GET SOME MORE
JRST SCANER ;GO TO SCANER
;SUBROUTINE TO GET A (CHANNEL) NUMBER IN T2
GETNUM: SETZ T2, ;CLEAR TOTALS
PUSHJ P,INCH ;GET CHARACTER
CAIG I,"9" ;TEST IF
CAIGE I,"0" ;NUMERIC
JRST .+4 ;NO
IMULI T2,^D10 ;BUMP UP
ADDI T2,-60(I) ;ADD
JRST GETNUM+1 ;LOOP
CAIN I,COMMA ;COMMA?
PUSHJ P,INCH ;EAT IT
POPJ P, ;RETURN
; SUBROUTINE TO GET A TAG INTO T2
;POINTER MUST BE AFTER THE $ OR * FOR LTAG ; BEFORE FOR DTAG
;RESPECTS ALL OTHER AC'S
DTAG: PUSHJ P,INCH ;GET DOLLAR
CAIE I,DOLLAR ;IN FACT?
CAIN I,"*" ;..
SKIPA
BOMB F.NTAG ;NO GOOD
LTAG: PUSH P,T1
PUSH P,T3 ;SAVE T1-T4
PUSH P,T4
TRO F,FR.NLC ;NO LC IN TAGS
PUSHJ P,LTAG1
TRZ F,FR.NLC
POP P,T4
POP P,T3 ;RESTORE T1-T4
POP P,T1
POPJ P, ;RETURN
LTAG1: MOVE T1,[POINT 6,T2] ;BYTE POINTER
SETZ T2, ;CLEAR TAG
MOVEI T3,6 ;6 CHARS. MAX
PUSHJ P,INCH ;GET ONE
CAIN I,DOLLAR ;BETTER NOT BE A $
BOMB F....$ ;IT WAS
TRZ F,FR.IGS ;NOW STOP IGNORING SPACES
PUSHJ P,CHKBRK ;SEE IF BREAK, RETURN IF NOT
SUBI I,40 ;TO SIXBIT
IDPB I,T1 ;DEPOSIT BYTE
SOJG T3,LTAG1+3 ;LOOP FOR 6 CHARS.
JRST BREAK ;RETURN ON BREAK CHAR.
;THIS IS CALLED WHEN A TAG IS FOUND ON PASS 2
EATAG: TRZ F,FR.IGS ;TURN OFF IGNORE
TRO F,FR.NLC ;NO LC (WOULD BE 'BREAK' CHARS.)
PUSHJ P,BREAK ;EAT UNTIL BREAK
SKIPA ;FIRST TEST BREAK
PUSHJ P,INCH ;EAT IT
CAIE I,TAB ;TAB?
CAIN I,SPACE ;OR SPACE?
JRST .-3 ;YES--IGNORE
CAIN I,CR ;<CR>?
PUSHJ P,INCH ;YES, EAT LF
CAIN I,LF ;<LF>?
JRST SCANER ;YES, START NEW LINE
TRO F,FR.IGS ;IGNORE SPACES,TABS
JRST SCAN2 ;START IN THE MIDDLE OF LINE
BREAK: PUSHJ P,INCH ;GET NEXT CHAR.
PUSHJ P,CHKBRK ;BREAK?
JRST BREAK ;NO, TRY AGAIN
;CHECK IF "I" IS A BREAK.
;RETURN IF NOT
;2 LEVEL RETURN IF BREAK
CHKBRK: CAIG I,"Z"
CAIGE I,"A" ;A-Z?
SKIPA
POPJ P, ;A-Z RETURN
CAIG I,"9"
CAIGE I,"0" ;0-9?
POP P,W ;BREAK!! UPCHUCK A LEVEL
POPJ P, ;POP&JUMP TO WHEREVER
;JUST LIKE WASTE, BUT BUMPS LOC AT END
PUSHJ P,INCH
WASTE2: TRNE F,FR.EOF
JRST EOF
CAIE I,LF
JRST WASTE2-1
AOS LOC
JRST SCANER
;SUBROUTINE TO ASSIGN ADDRESSES TO UNDEFINED SYMBOLS AT END OF PASS 2
LODTAG: PUSHJ P,INIT2 ;PASS2 OVERHEAD
SETZ T1, ;START SEARCH OF SYMBOL TABLE
L2: MOVEI T3,TAGSIZ ;SIZE OF TAG
SKIPN SYMTAB(T1) ;TEST SYMBOL
POPJ P, ;NOBODY HOME
AOJ T1, ;INDEX TO THE ADDRESS PART
HRRZ T2,SYMTAB(T1) ;GET ADDRESS
SKIPE T2 ;SKIP IF NO ADDRESS
AOJA T1,L2 ;SYMBOL WITH ADDRESS-TRY NEXT SYMBOL
HLLZ T2,SYMTAB(T1) ;GET FLAGS
TLNE T2,1 ;GLOBAL SYMBOL REQUEST?
AOJA T1,L2 ;DON'T EVEN THINK ABOUT IT.
TLNE T2,4 ;NUMERIC?
MOVEI T3,2 ;YES--SIZE OF TAG = 2
LDB P1,[POINT 12,T2,11] ;SHOULD POINT TO DIM. LEN.
MOVE T2,ENDLOC ;GET ENDLOC
HRRM T2,SYMTAB(T1) ;ENDLOC IS THE ADDRESS FOR THE TAG
MOVE T4,[ASCIZ/0/]
ADD T2,PROGRM ;ADD OFFSET FOR CORE LOC.
MOVEM T4,(T2) ;INIT AS ASCII ZERO
JUMPE P1,.+3 ;JUMP IF NO DIMENSION
IMUL P1,T3 ;DIMENSION * WORDS/TAG
ADDM P1,ENDLOC ;BUMP UP ENDLOC
ADDM T3,ENDLOC ;ALWAYS AT LEAST ONCE (ALSO FOR ORIGIN 1)
PUSHJ P,CHKEND ;SEE IF ENDLOC IS ABOVE K BOUNDARY
AOJA T1,L2 ;NEXT SYMBOL.
;SUBROUTINE TO STORE INSTRUCTION IN T1
;AND IMPLICITELY DEFINE THE SYMBOL
;(NOT TO BE USED WITH "*" TAGS)
;PERFORM GLOBAL FIXUPS
LODACC: PUSH P,T1 ;SAVE INSTR.
PUSHJ P,LTAG ;LOAD THE TAG
JUMPE T2,[BOMB (F.NTAG)] ;NO TAG
TRO F,FR.IGS ;IGNORE SPACES AGAIN
PUSHJ P,SRCTAB ;SEARCH SYMBOL TABLE
MOVEM T2,SYMTAB(T1) ;PUT IN TAG W/NO ADDRESS
MOVE W,T1 ;SAVE INDEX
POP P,T1 ;RESTORE INSTR.
TRZE F,FR.GLB ;GLOBAL SYMBOL?
JRST LGLB ;YES
HLRZ T3,SYMTAB+1(W) ;GET ITEM TYPE
CAIE T3,1 ;GLOBAL SYMBOL?
JRST STOREX ;NO-PJRST OUT
LGLB: HRRZ T3,SYMTAB+1(W) ;GET ADDRESS
HRR T1,T3 ;SET UP GLOBAL LINK
SKIPN T3 ;END GLOBAL LINK?
TLO T1,20 ;YES, FLAG FOR NON-RELOC.
PUSHJ P,STOREX ;STORE IT
MOVE T1,LOC ;GET LOCATION
SOJ T1, ;BACK UP ONE TO CURRENT POSITION
HRLI T1,1 ;FLAG AS GLOBAL
MOVEM T1,SYMTAB+1(W) ;RE-LINK SYMBOL TABLE
POPJ P, ;RETURN
;SUBROUTINE TO STORE THE 1ST 4 INSTRUCTIONS OF THE PROGRAM
; MOVEI 1,0 ;ADDRESS OF TABLE
; GETSEG 1, ;GET OTS
; HALT ;NO OTS
; JSP 2,400010 ;ENTRY POINT OF OTS
INIT: MOVSI T3,-TABLNG ;TABLE LENGTH
MOVE T1,FTAB(T3) ;GET INSTR
PUSHJ P,STOREX ;STUFF
AOBJN T3,.-2 ;LOOP
MOVEM T3,FSTLOC ;SAVE THE 1ST NON-OVERHEAD LOC
POPJ P,
FTAB: MOVEI 1,
CALLI 1,40
JRST 4,0
JSP 2,400010
TABLNG==.-FTAB
;SUBROUTINE TO LOAD THE GETSEG TABLE IN THE 1ST LITERAL LOC
INIT2: MOVE T1,ENDLOC ;1ST FREE
HRRM T1,@PROGRM ;FOR 1ST INSTR. (THE MOVEI 1,)
MOVSI T2,-LEN ;GET TABLE LENGTH
ADD T1,PROGRM ;MAKE ABS ADDRESS
MOVE T3,LTAB(T2) ;GET TABLE ENTRY
MOVEM T3,(T1) ;STORE IT
AOJ T1, ;NEXT CORE LOC
AOBJN T2,.-3 ;NEXT TABLE LOC & LOOP
ADDI T1,3 ;ADD 3 NULLS
SUB T1,PROGRM ;MINUS OFFSET
MOVEM T1,ENDLOC ;UPDATE ENDLOC
JRST CHKEND ;CHECK IT
LTAB: SIXBIT /SYS/
SIXBIT /PILOTS/
SIXBIT /EXE/
LEN==.-LTAB
;SUBROUTINE TO RENDER CERTAIN SYMBOLS INTERNAL OR EXTERNAL OR NUMERIC
NUMRIC: MOVSI T3,4 ;4=NUMERIC
JRST INTER+1
EXTER: SKIPA T3,[1,,0] ;1=EXTERNAL
INTER: MOVSI T3,2 ;2=INTERNAL
PUSHJ P,SRCTAB ;FIND SYMBOL (OR END OF TABLE)
MOVEM T2,SYMTAB(T1) ;IF NOT THERE, STICK IT
HLLM T3,SYMTAB+1(T1) ;FOR LATER
POPJ P, ;RETURN
;SUBROUTINE TO LOAD ADDRESS OF SYMBOL
;THAT HAS BEEN DEFINED IN PASS 1 INTO C(LOC)
;POSITION BEFORE $ OR *
;IF ADDRESS THERE FROM PASS 1, CHECK THAT THEY ARE THE SAME
;USES T1 - T3 ;AT END T1 POINTS TO SYMTAB ENTRY
L2TAG: PUSHJ P,INCH ;GET NEXT CHAR.
CAIE I,"*" ;SHOULD BE TAG
CAIN I,DOLLAR ;OF SOME SORT
JRST .+3 ;YES
CAIE I,"#"
BOMB F.NTAG ;NO TAG
L2TAG1: PUSHJ P,LTAG ;LOAD TAG
TRO F,FR.IGS ;IGNORE SPACES
PUSHJ P,SRCTAB ;SEARCH SYMBOL TABLE
BOMB F.UNDF ;UNDEFINED SYMBOL
MOVE T2,SYMTAB+1(T1) ;GET ADDRESS
TLNE T2,1 ;CHAINED GLOBAL SYMBOL?
POPJ P, ;YES--ITS ALREADY SET UP
MOVE T3,LOC ;GET LOC
ADD T3,PROGRM ;ADD OFFSET
HRRZ T3,(T3) ;GET ADDR.
JUMPE T3,L2TAG2 ;NO TEST IF NOT DEF.
CAMN T3,T2 ;LOCATIONS SAME?
JRST CPOPJ ;YES, RETURN
TRNN F,FR.BOM ;FATAL ERROR ALREADY?
BOMB F.SYNC ;MEMORY OUT OF SYNC
L2TAG2: MOVE T3,LOC ;NO. THEN DONT CONFUSE THE ISSUE
ADD T3,PROGRM ;RESET T3
HRRM T2,(T3) ;STORE ADDRESS
POPJ P, ;RETURN
;SUBROUTINE TO LOAD THE OPCODE IN T4
;AND THE SYMBOL FROM THE SYMBOL TABLE
;BUT DOSEN'T MAKE ANY ENTRIES IN THE SYMBOL
;THEREFOR THIS IS FOR "*" (EXPLICITELY DEFINED) TAGS ONLY
;(LODACC IS FOR "$" TYPE TAGS ON PASS 1)
L1TAG: PUSHJ P,DTAG ;LOAD TAG IN B
TRO F,FR.IGS ;IGNORE SPACES
PUSHJ P,SRCTAB ;SEARCH TABLE
JRST .+3 ;NO MATCH
MOVE T2,SYMTAB+1(T1) ;GET ADDRESS
SKIPA
SETZ T2, ;ZERO OUT ADDRESS IF NOT DEFINED
HRR T4,T2 ;COMPLETE INSTRUCTION
MOVE T1,T4 ;FOR STOREX
JRST STOREX ;LOAD INST.
;SUBROUTINE TO MAKE LSTFILE HEADERS
;CALL HEDDR0 FOR NEW PAGE BUT NO FF (START OF PROGRAM)
;CALL HEDDR1 ON PAGE OVERFLOW - NEW SUBPAGE
;CALL HEDDER FOR NEW PAGE
HEDDR0: AOS PAGE ;PAGE 1
JRST HEDDER+2 ;AND SKIP FF
HEDDR1: AOS SUBPAG ;NEXT SUBPAGE
HEDDER: MOVEI I,FF ;NEW PAGE
PUSHJ P,LOUCH
SETZM LINCNT
PUSH P,T1 ;MAKE STORAGE
PUSH P,T2
MOVE T1,[POINT 6,LOOKIT]
H1: ILDB I,T1 ;GET FILENAME
JUMPE I,H2 ;JUMP WHEN DONE
ADDI I,40 ;TO ASCII
PUSHJ P,LOUCH ;OUTPUT
TLNE T1,770000 ;ALL SIX?
JRST H1 ;NO LOOP
H2: MOVEI P1,[ASCIZ/.PIL /]
PUSHJ P,LSTSTR ;MAKE .PIL WHETHER IT IS OR NOT
MOVEI P1,[ASCIZ/CERRITOS COLLEGE /]
PUSHJ P,LSTSTR ;A LITTLE PLUG
MOVEI P1,[ASCIZ/PILOT VERSION /]
PUSHJ P,LSTSTR
HLRZ P2,.JBVER ;GET L.H. .JBVER
LSH P2,-6 ;SHIFT DOWN TO MAJOR VERSION
PUSHJ P,OCTOUT ;IN OCTAL
HLRZ I,.JBVER ;GET IT AGAIN
ANDI I,77 ;MASK OFF MINOR VERSION
JUMPE I,.+3 ;JUMP IF NO MINOR VERSION
ADDI I,100 ;ADD ASCII OFFSET
PUSHJ P,LOUCH ;OUTPUT
MOVEI P1,[ASCIZ/ EDIT /]
PUSHJ P,LSTSTR
HRRZ P2,.JBVER ;GET R.H. .JBVER
PUSHJ P,OCTOUT ;IN OCTAL
MSTIME T1, ;GET TIME OF DAY
IDIVI T1,^D1000 ;GET RID OF MS.
IDIVI T1,^D60 ;AND SECONDS
IDIVI T1,^D60 ;AND MINUTE
MOVEI P1,[ASCIZ/ /] ;2 SPACES
PUSHJ P,LSTSTR ;TYPE SEPERATOR
MOVE P2,T1 ;GET HOUR
PUSHJ P,DECOUT ;PRINT HOUR
MOVEI I,COLON
PUSHJ P,LOUCH ;PRINT COLON
MOVE P2,T2 ;GET MINUTES
IDIVI P2,^D10 ;GET TENS OF MINUTES
MOVEM P3,T2 ;SAVE REST
PUSHJ P,DECOUT ;TYPE TENS OF MINUTES
MOVE P2,T2
PUSHJ P,DECOUT ;TYPE MINUTES
MOVEI P1,[ASCIZ/ /] ;2 SPACES
PUSHJ P,LSTSTR ;SEPERATOR,
DATE T1, ;GET DATE
IDIVI T1,^D31 ;DAY-1 IN T2
MOVEI P2,1(T2) ;SAVE DAY
IDIVI T1,^D12 ;MONTH-1 IN T2, YEAR-1964 IN T1
PUSHJ P,DECOUT ;OUTPUT DAY
MOVE P2,MONTAB(T2) ;GET MONTH NAME
MOVEI P1,P2 ;..
PUSHJ P,LSTSTR ;OUTPUT
ADDI T1,^D64 ;GET YEAR + 64
MOVE P2,T1 ;SAVE
PUSHJ P,DECOUT ;OUTPUT YEAR
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
MOVEI P1,[ASCIZ/ PAGE /]
PUSHJ P,LSTSTR ;SAY "PAGE"
MOVE P2,PAGE ;GET PAGE
PUSHJ P,DECOUT ;OUTPUT
SKIPN P2,SUBPAG ;GET SUBPAGE
JRST .+4 ;NO SUBPAGE
MOVEI I,"-"
PUSHJ P,LOUCH ;TYPE PAGE-SUBPAGE SEPERATOR
PUSHJ P,DECOUT ;TYPE SUBPAGE
MOVEI P1,CRLF ;END OF LINE
PUSHJ P,LSTSTR ;OUTPUT
PUSHJ P,LSTSTR ;AGAIN
PUSHJ P,LSTSTR ;AND AGAIN..
POPJ P, ;DONE WITH HEADING
MONTAB: MONMAC <JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
LINER: SKIPN EDLINE ;SOS LINE NUMBER?
JRST NOEDIT ;NO--DO INTERNAL LINE #
MOVE T2,EDLINE ;GET LINE #
SETZ T3, ;FOR ASCIZ
OUTSTR T2 ;OUTPUT LINE #
POPJ P, ;RETURN
NOEDIT: MOVE T2,LINE ;GET INTERNAL LINE NUMBER
TTYNUM: IDIVI T2,^D10 ;STANDARD ROUTINE
JUMPE T2,.+4
PUSH P,T3
PUSHJ P,TTYNUM
POP P,T3
ADDI T3,60
OUTCHR T3
POPJ P,
PUNT: TRO F,FR.BOM
TRNN F,FR.P2 ;PASS 2?
JRST DO1BIT ;NO, SAVE IT
MOVE P3,ERRTAB(T1) ;YES, SAVE TILL EOL
ENDBIT: TRNN F,FR.P2 ;ON PASS 2?
SETZ P3, ;NO,CLEAN UP UNUSED ERROR
JRST WASTE
DO1BIT: MOVSI T2,-100
SKIPE PASS1B(T2)
AOBJN T2,.-1
JUMPGE T2,ENDBIT
MOVE T3,LINE
HRLZM T3,PASS1B(T2)
MOVE P3,ERRTAB(T1)
HRRM P3,PASS1B(T2)
JRST ENDBIT
CRLF: ASCIZ/
/
TABLIN: ASCIZ / /
DEFINE FX (X,Y),<
XLIST
[ASCIZ/Y/]
LIST>
ERRTAB: FATALS
PRGEND
SEARCH PILUNV
.TITLE PILREL - RELFILE GENERATOR
LODREL: CLOSE IN, ;DONE WITH THE INPUT.
RELEAS IN, ;..
MOVE T1,SVJBFF ;RESTORE .JBFF
MOVEM T1,.JBFF ;TO ORIGINAL STATUS
MOVEI T1,1 ;ASSUME AN ERROR
TRNE F,FR.BOM ;DID WE BOMB?
ADDM T1,.JBERR ;YES-BUMP UP .JBERR
MOVEI T1,14 ;BINARY MODE
MOVSI T2,'DSK' ;ON DSK
HRLZI T3,OBUF ;BUFFER.
OPEN OUT,T1 ;OPEN SESAME...
JRST OPNERR ;JUST NOT MY DAY..
SKIPN T1,RELNAM ;USE THE SPECIFIED RELFILE NAME
MOVE T1,LOOKIT ;OR SOURCE FILE NAME
CAMN T1,[SIXBIT/-/] ;NO RELFILE?
JRST RESTRT ;QUIT
SKIPN T2,RELEXT ;SPECIFIED EXT.
MOVSI T2,'REL' ;OR DEFAULT
SETZB T3,T4
ENTER OUT,T1 ;MAKE A RELFILE
JRST ENTERR ;A LOSER
MOVE T1,[6,,1] ;ITEM TYPE 6 (NAME)
PUSHJ P,OUCH ;OUTPUT
SETZ T1, ;ZERO T1
PUSHJ P,OUCH ;
MOVE T1,R50NAM ;PROGRAM NAME
PUSHJ P,OUCH ;OUTPUT
SETZM LOC ;ZERO LOCATION COUNTER
MOVE T4,PROGRM ;GET OFFSET
MOVE T2,ENDLOC ;LAST LOC
GOLOOP: CAIG T2,21 ;MORE THAN 1 BLOCK?
JRST LAST ;LAST
PUSHJ P,DOIT ;COMPUTE RELOCATION
SUBI T4,21 ;GO BACK
PUSHJ P,WRITE ;DO THE DATA THING
MOVEI T1,21 ;FULL 18 WORDS
ADDM T1,LOC ;INDEX.
SUBI T2,21 ;LESS 1 BLOCK
JRST GOLOOP ;LOOP
DOIT:
HRLZI T1,1 ;BLOCK TYPE 1
HRRI T1,22 ;18 WORDS LONG
PUSHJ P,OUCH
MOVEI T3,21 ;COUNTER
D1: SETZ T1, ;CLEAR WORD
MOVE P1,[POINT 2,T1] ;RELOC BYTE POINTER
MOVEI P2,1 ;1ST IS RELOCATED
IDPB P2,P1 ;STUFF.
LOOP: CAML T4,LITLOC ;ABOVE LITERALS?
JRST R00 ;YES--ABSOLUTE
HLLZ P2,(T4) ;GET INSTR.
MOVSI P3,-ITABLN ;SET UP LOOP
CAME P2,ITAB(P3) ;MATCH?
AOBJN P3,.-1 ;NO-LOOP
JUMPL P3,LOOP1 ;MATCH, SKIP OTHER TEST
MOVSI P3,-STABLN ;SPECIAL TAB LENGTH
MOVE W,P2 ;SAVE P2
AND P2,[777000,,0] ;MASK OPCODE
CAME P2,STAB(P3) ;GENERIC OPCODE MATCH?
AOBJN P3,.-1 ;NO-LOOP
JUMPGE P3,R00 ;NO MATCH, MUST BE ABS.
MOVE P2,W ;RESTORE P2
LOOP1: TLNN P2,20 ;IF INDIRECT-END GLOBAL LINK
SKIPA P2,[1] ;WORD IS RELOC.
R00: SETZ P2, ;WORD IS ABS
IDPB P2,P1 ;DEPOSIT RELOC
AOJ T4, ;NEXT LOCATION
SOJG T3,LOOP ;LOOP
PUSHJ P,OUCH ;WRITE RELOC WORD
POPJ P, ;RETURN.
WRITE: MOVEI T3,21 ;17 WORDS OF DATA
MOVE T1,LOC ;GET BLOCK START ADDRESS
PUSHJ P,OUCH ;WRITE IT
MOVE T1,(T4) ;GET DATA
CAMGE T4,LITLOC ;DON'T CLOBBER LITERALS
TLZ T1,20 ;CLEAR GLOBAL END LINK BIT
PUSHJ P,OUCH ;WRITE IT.
AOJ T4, ;NEXT WORD
SOJG T3,.-5 ;LOOP
POPJ P, ;RETURN
LAST: HRLZI T1,1 ;LINK ITEM TYPE 1
HRR T1,T2 ;HOWEVER MANY LEFT
AOJ T1, ;+ 1 FOR BLOCK START ADDRESS
PUSHJ P,OUCH ;OUTPUT
MOVE T3,T2 ;SAVE T2
PUSHJ P,D1 ;COMPUTE RELOCATION
SUB T4,T2 ;GO BACK
MOVE T1,LOC ;BLOCK START ADDRESS
PUSHJ P,OUCH ;WRITE IT
MOVE T1,(T4) ;GET DATA
CAMN T1,[PUSHJ 17,@0]
TLZ T1,20 ;CLEAR INDIRECT BIT
PUSHJ P,OUCH ;WRITE IT.
AOJ T4, ;NEXT
SOJG T2,.-5 ;LOOP
SETZB P1,P3 ;RESET ACS
SKIPE SYMTAB(P3) ;EMPTY SYMBOL TABLE ENTRY?
AOJA P3,.-1 ;NO,TRY AGAIN
SYMBOL: CAIG P3,22 ;OVER 1 BLOCK?
JRST ENDSYM ;NO-1 BLOCK OR LESS
SUBI P3,22 ;MINUS 1 BLOCK
MOVE T1,[2,,22] ;LINK ITEM TYPE 2 (SYMBOL)
PUSHJ P,OUCH ;
MOVE T1,[042104210421];RELOCATION WORD
PUSHJ P,OUCH ;
MOVEI P2,11 ;9 SYMBOLS AT A SHOT
SYM1: MOVE T1,[POINT 6,SYMTAB(P1)] ;GET TAG
PUSHJ P,RDX51-1 ;GET RADIX 50 SYMBOL IN T3
MOVE T1,T3 ;TRANSFER SYMBOL
AOJ P1, ;2ND ITEM IN SYMBOL TABLE
MOVE T2,SYMTAB(P1) ;GET IT.
AOJ P1, ;NEXT
MOVSI T3,1B20 ;ASSUME LOCAL SYMBOL
TLNE T2,1 ;IS IT A GLOBAL SYMBOL REQUEST?
MOVSI T3,3B19 ;YES
TLNE T2,2 ;IS IT AN INTERNAL SYMBOL?
MOVSI T3,1B21 ;YES
TDO T1,T3 ;FLAG WHAT KIND OF SYMBOL
PUSHJ P,OUCH ;WRITE RADIX 50 SYMBOL
HRRZ T1,T2 ;MOVE ADDRESS ONLY
PUSHJ P,OUCH ;WRITE SYMBOL ADDRESS
SOJG P2,SYM1 ;LOOP FOR 9 SYMBOLS
JRST SYMBOL ;LOOP FOR NEXT BLOCK OF SYMBOLS
ENDSYM: JUMPE P3,ENDS1 ;NO SYMBOLS = NO SYMBOL TABLE BLOCK
HRLI T1,2 ;LINK ITEM TYPE 2 (SYMBOL)
HRR T1,P3 ;NO. OF SYMBOLS & ADDRESSES
PUSHJ P,OUCH ;
SETZ T1, ;CLEAR T1
MOVE T1,[042104210421];FULL BLOCK RELOCATION
MOVEI T4,22 ;ASSUME 22 WORDS
SUB T4,P3 ;DIFFERENCE FROM # OF SYMBOLS
IMULI T4,2 ;TIMES 2
SETZ T3, ;CLEAR MASK
SETO T2, ;INITIALIZE MASKER
LSHC T2,(T4) ;SHIFT THE BITS
AND T1,T2 ;MASK OFF THE RELOCATION WORD
PUSHJ P,OUCH ;WRITE IT
IDIVI P3,2 ;SYMBOLS/2
SYM2: MOVE T1,[POINT 6,SYMTAB(P1)] ;NEXT TAG
PUSHJ P,RDX51-1 ;MAKE RADIX 50
MOVE T1,T3 ;MOVE SYMBOL
AOJ P1, ;NEXT
MOVE T2,SYMTAB(P1) ;GET ADDRESS
AOJ P1,
MOVSI T3,1B20 ;ASSUME LOCAL
TLNE T2,1 ;GLOBAL?
MOVSI T3,3B19 ;YES
TLNE T2,2 ;LOCAL?
MOVSI T3,1B21 ;YES
TDO T1,T3 ;OVERLAY LOCAL,INTERNAL,OR GLOBAL
PUSHJ P,OUCH ;WRITE IT
HRRZ T1,T2 ;MOVE ADDRESS
PUSHJ P,OUCH ;OUTPUT
SOJG P3,SYM2 ;LOOP
ENDS1: TRNE F,FR.END ;DOES THIS PROGRAM HAVE A START ADDRESS?
JRST ENDREL ;NO-SKIP THE START ADDRESS
MOVE T1,[7,,1] ;LINK ITEM TYPE 7 (START ADDRESS)
PUSHJ P,OUCH ;WRITE IT.
HRLZI T1,200000 ;RELOCATION
PUSHJ P,OUCH ;.
SETZ T1, ;START AT LOCATION 0
PUSHJ P,OUCH ;
ENDREL: MOVE T1,[5,,2] ;LINK ITEM TYPE 5 (END)
PUSHJ P,OUCH ;
HRLZI T1,200000 ;RELOCATION WORD
PUSHJ P,OUCH ;
MOVE T1,ENDLOC ;1ST FREE LOCATION
PUSHJ P,OUCH ;
SETZ T1, ;1ST ABSOLUTE ADDRESS
PUSHJ P,OUCH ;SUPPRISE! THERE IS NONE.
CLOSE OUT, ;CLOSE REL FILE
RELEAS OUT, ;RELEASE CHANNEL
RESTRT: TRZ F,-1 ;CLEAR ALL TEMP FLAGS
JRST START ;GO BACK TO COMAND SCANNER
OUCH: SOSGE OBUF+2
JRST .+3
IDPB T1,OBUF+1
POPJ P,
OUT OUT,
JRST OUCH
OUTSTR [ASCIZ/RELFILE I-O ERROR/]
EXIT
ENTERR: [ASCIZ/RELFILE ENTER ERROR
/]
EXIT
OPNERR: [ASCIZ/RELFILE OPEN ERROR
/]
EXIT
;TABLE OF ALL PILOT OPCODES THAT HAVE RELOCATABLE ADDRESSES
ITAB: MOVEI 1,
OUTSTR
IONEOU
JRST
JUMPE 1,
JUMPN 1,
SOJG 2,
CALL.
GETC.
GETR.
GETD.
GETT.
GETL.
STRN.
UNSTR.
NMAT.
NMATL.
NMATG.
ACCPT. 1,
ACCPT. 2,
ACCPT. 3,
JUMP
PUSHJ 17,
TRAP.
CJUMP.
CPUSH.
COMP.
CPLUS.
CMIN.
CMULT.
CDIV.
INDEX.
INDEX. 1,
ITABLN==.-ITAB
;TABLE OF OPCODES THAT ARE RELOCATABLE NO MATTER WHAT AC IS USED
STAB: IN.
OUT.
GET.
PUT.
STABLN==.-STAB
END