$JOB COMASM[5,1] $; $; THIS JOB ASSEMBLES ALL SOURCE MODULES FOR AN OVERLAYED $; DOS/BATCH FORTRAN COMPILER $; $; $; THIS SECTION ASSEMBLES ALL MODULES THAT ARE COMMON TO $; BOTH DOS/BATCH V05/06 AND RSX11D V07 FORTRAN COMPILERS $; $RUN MACRO #ASC2,LP: NOT IN I/O LIST MOV #'I,R4 JSR PC,PUTCHR JSR PC,OUTGL JSR PC,EOL BR ASG11 1$: ; ; END OF SPECIAL HANDLING ; MOV R2,R4 ADD #60,R4 ;FOLLOWED BY A JSR PC,PUTCHR ;MODE BITB BITM(R2),GL1(R0) ;DO WE NEED A POP GLOBL BNE ASG11 ;NO BISB BITM(R2),GL1(R0) ;SET GENERATED BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ASG11: JSR PC,OUTNAM ;NOW OUTPUT THE NAME JSR PC,OUTCOM ;FOLLOWED BY TH NO ASF CMPB #'),(R1)+ ;IS IT A CLOSING PAREN? BEQ 3$ ;YES CMPB #'(,-1(R1) ;WAS IT AN OPEN PAREN? BNE 2$ ;NO INC (SP) ;YES, UP THE COUNT BR 2$ ;AND KEEP LOOPING 3$: DEC (SP) ;DECREMENT NESTING COUNT BPL 2$ ;CONTINUE IF MORE TO SEE TST (SP)+ ;DISCARD COUNT JSR PC,CNXC ;SKIP BLANKS CMPB #'=,(R1) ;IT MUST BE AN EQUAL TO BE ASF BNE ASF01X ;ISN'T MOV (SP)+,R1 ;RESET TEXT POINTER INCB GETSW ;ENABLE FUNCTION CHECK JSR PC,GET ;MUST BEGIN WITH IDENTIFIER BVS ASF01Y ;BAD NAD04,LP:NOT FUNCTION ; ;FROM HERE ON ASSUME IS AN ASF ; ASF200: MOV CURSYM,R0 ;BASE OF FUNCTION NAME ENTRY BIT #170000,COMWD(R0) ;ANY PREV ALLOCATION IS AN ;ERROR IN THIS NAME BNE ASF203 ;BR=>NAME ERROR BIC #ENTYMM,ENTYWD(R0) BR ASF202 ;BR=>NAME OKAY ASF203: TRAP+96. ASF202: BIS #40000,ENTYWD(R0) ;MARK AS ASF MOV DATYWD(R0),R2 ;EXTRACT TYPE BIC #DATYMK,R2 CLC ;ALIGN FOR LATEFUNNAM.OBJ,ERRPRT.OBJ #T2JSR%4,$POLSH" ;COLLECT ARGUMENTS ; AS EACH ARGUMENT IS ENCOUNTERED ; IT IS PLACED ON THE STACK UNDER THE ; TOP OF THE STACK (WHICH IS THE COUNT ; OF ARGUMEJ,OUTSL.OBJ,HDRGEN.OBJ,UTILTY.OBJ #T5 IS A CONSTANT MOV CURSYM,R4 BIT SGLWD(R4),#SGLMKM BNE ASF210 ;BR=> IS FIRST OCCURANCE, USE IT! ;CREATE NEW ENTRY. MOV CURSYM,R0 ;FORCE A NEW ENTRY FOR THIS SYMBOL JSR PC,PUTSYM BR ASF210 ; ; HANDLE A BAD PARAMETER ; ASF280: TRAP+53. ;"BAD PARAMETER" ASF282: CMPB #',,@R1 ;LOOK FOR NEXT , OR ) L.OBJ,HDRGEN.OBJ,UTILTY.OBJ,RDCI.OBJ #T5 +X .ENDM .ENDC .ENDM .MACRO CNDGLB ARG JSR R5,CNDGLB .IRP X, +X .ENDM .ENDM .MACRO CNDGLN TYPE,BYTE,TEXT .IF DIF TYPE,R2 MOV TYPE,R2 .ENDC .IF DIF BYTE,R3 MOV BYTE,R3(SF510 ;BR=>OKAY TRAP+93. ;EXPRESSION ERROR IN ASF ; ;FORCE THE TYPE TO MATCH THE FUNCTION TYPE ; ASF510: BIC #070000,2(SP) BIS FNCTYP,2(SP) ; ;INVOKE CODE OUTPUT MOV R0,-(SP) ;SAVE FOR CLEAN-UP JSR PC,EXPGEN ; ;STACK CLEAN UP TIME ; MOV @SP,SP TST (SP)+ ;FINISH UP .GLOBL PUTNAM,PUTCHR ;CODE TO MOVE VALUE FROM STACK TO REGISTERS MOV #ASFT03,R4 JSR PC,PUTNAM ;SELECT AND OUTPUT DATA TYPE NUMBER MOV FNCTYP,R4 ROR R4 ROR R4 ROR R4)OUTINE 'ALOCAT' IS CALLED TO COMPLETE THE ; HANDLING OF THESE STATEMENTS. AT THIS POINT THE ; STORAGE FOR COMMON & EQUIVALENCE CAN BE ; RECOVERED AND REUSED. .GLOBL COMHED,LOCADB,OUTLN1,OUTLN2,OUTCH2,ALOCAT .GLOBL DATYWD,DATYMK,ADBPWD,ADJWD,ADJMKM .GLOBL SYMBAS,OUTCST,SIZESM,SIZESN,SIZESQ,SIZT .GLOBL ZLEQLS,QADBOK,COMWD,COMMKM,COMNWD .GLOBL CNXC,GETID,LSTITM,EQVDEL .GLOBL NXTCH,COMMON,EOL,EQVH3,EQVDEL .GLOBL OUTST,OUTOCT,TYPSIZ,BLKNAM .GLOBL FRHIGH,FRLOW,COMNUM,OUTSTR ;COM* .TITLE CORET ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL GENLAB,NXTCH,ROUTIN,OUTTAB,NAMSER .GLOBL SERATR,OUTSER,EOL,BITM,GL1,PUTNAM .GLOBL MISC,OUTGL,OUTNAM,PUTCHR,CONTIN .GLOBL RETURN,PSHMKM,PSHWD,CURSYM .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11 ; ; CONTINUE STATEMENT ; CONTIN: J+ .ENDC .IF DIF TEXT,R4 MOV TEXT,R4 .ENDC CALL CNDGLN .ENDM .SBTTL MAJOR ENTRY POINTS ; ; EXPRESSION AND ASSIGNMENT GENERATION ; ; ON ENTRY R0 = ADDRESS OF INTERNAL POLISH ; AND, IF AN ASSIGNMENT, 'LHSPOL' IS ADDRESS ; OF INTERNAL POLISH FOR LEFT HAND SIDE ; .GLOBL EXPGEN,CALGEN,NARGEN EXPGEN: CALL INIT CALL DSPTCH BR EXIT ; ; CALL STATEMENT GENERATION - WITH ARGUMENTS ; ; ON ENTRY R0 = ADDRESS OF INTERNAL POLISH ; CALGEN: CALL I, ROR R4 SWAB R4 BIC #177770,R4 ADD #60,R4 JSR PC,PUTCHR .GLOBL BITM,GL1,OUTGL,EOL,OUTNAM SUB #60,R4 BITB BITM(R4),GL1+6 BNE ASF60A BISB BITM(R4),GL1+6 ;SET THE GENERATED BIT JSR PC,OUTGL ;GENERATE A GLOBAL JSR PC,EOL ;AND AN END OF LINE ASF60A: JSR PC,OUTNAM ;GENERATE THE NAME ;CODE TO EXIT POLISH MODE AND RETURN JSR R5,OUTLN2 ;.+2 ASFT04 ;RTS%5 ;;NOW FIX UP THE SYMBOL TABLE ;THE NAMES OF DUMMY ARGUMENTS ARE CLEARED MOV (SP)+,R0 ;NUMB-MON DATA STRUCTURE ; ; COMHED - POINTS TO FIRST BLOCK ; ; ; BLOCK: WORD 0 - LINK TO NEXT BLOCK ; WORD 1 - FIRST TWO LETTERS OF BLOCK NAME ; WORD 2 - SECOND TWO LETTERS OF BLOCK NAME ; WORD 3 - LAST TWO LETTERS OF BLOCK NAME ; WORD 4 - ZERO TO TERMINATE NAME ; WORD 5 - LINK TO SUBBLOCKS ; ; SUBBLOCK: WORD 0 - ZERO TERMINATOR FOR SUBBLOCK ; WORD 1+N - LINK TO STE OF N'TH VARIABLE ; WORD 2+N - LINK TO NEXT SUBBLOCK R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; COMMON: TSTB .SR PC,GENLAB ;GENERATE A LABEL IF ANY RCCOM: JSR PC,NXTCH ;MAKE SURE TST R2 BEQ CONT01 ;NO ADDITIONAL CHARACTERS TRAP+29. ;ILLEGAL TERMINATION CONT01: RTS PC ; ; RETURN STATEMENT ; RETURN: JSR PC,GENLAB ;GENERATE THE LABEL .GLOBL GOFLG INCB GOFLG CMP ROUTIN,#2 ;IS THIS A FUNCTION? BNE RET2 ;NO JSR PC,OUTTAB MOV NAMSER,R0 ;GET THE SERIAL NUMBER JSR PC,SERATR ;AND ITS ATTRIBUTES MOV R0,R3 MOV CURSYM,R0 ;FLAG ENTRY BIS #PSHMKM,PSHWD(R0) ;FOR PUSH GENERATION MOV #'P,R0 /NIT CALL DSPREC CALL POP CMP #COD.G,LTCOD BEQ 1$ MOV TEXTR1,R1 ;RESET R1 FOR ERROR PROCESSOR TRAP+21. ;UNRECOGNIZED STATEMENT 1$: BR EXIT ; ; CALL STATEMENT - WITHOUT ARGUMENTS ; ; ON ENTRY R0 = SYMBOL TABLE ADDRESS OF SUBROUTINE NAME ; NARGEN: MOV SERWD(R0),NARGCL-4 MOV #NARGCL,R0 CALL INIT CALL FUNCAL BR EXIT ; ; INITIALIZE NEEDED STACK & POINTERS ; INIT: MOV R0,POLPTR MOV R1,TEXTR1 CLR EXTFLG ; ; CHECK IF GLOBL BIT TABLES NEED TO BE ZEROED ; BITB BITM+6,0ER OF PARAMETERS BEQ ASF610 ;IN CASE OF ZERO ARGS ASF600: MOV (SP)+,R2 ;PARAMETER ADD SYMBAS,R2 ;MAKE AN ADDRESS CLR SYM1WD(R2) ;MAKE NULL NAME CLR SYM2WD(R2) DEC R0 BNE ASF600 ;NOW LABEL THE NEXT LOCATION FOR FORWARD JUMP ;OVER THE FUNCTION CODE ASF610: JSR PC,GNTL$S ;$SNNNN=. ; ;WE ARE ALL DONE AND IT CAME OUT RIGHT. ; CLRB GETSW ;RESTORE TO PRE-ASF STATE CLV RTS PC ;ERROR MESSAGES ; ASF299: MOV (SP)+,R0 ;ARGUMENT COUNT BGT ASF600 ;BR TO CLEAN UP SYMBOL TABLE BR ASF6101ALOKAT BGT COMM05 JSR PC,ZLEQLS ;LOOK FOR ZERO LEVEL EQUALS BCC COMM00 ;BR => CONSIDER A COMMON STMT COMM05: SEV ;RETRY AS ASSIGNMENT RTS PC ; COMM00: JSR PC,CNXC ;ENTRY POINT - GET NEXT NONBLANK CMPB #'/,@R1 BNE COMM01 ;BR = > BLANK COMMON INC R1 COMM02: JSR PC,CNXC ;NEXT NON-BLANK CMPB #'/,@R1 BNE COMM03 ;BR => NAMED COMMON ; ;BLANK COMMON ; TSTB (R1)+ ;MOVE R1 PAST / COMM01: MOV #BLANKC,R0 ;FAKE NAME MOV #BLKNAM,R2 ;CURRENT BLOCK NAME MOV (R0)+,(R2)+ MOV (R0)+,(R22JSR PC,OUTSER ;OUTPUT THE PUSH JSR PC,EOL ;AND AN END OF LINE MOV #RETPOP,R4 ;AND THE JSR PC,PUTNAM ;SPECIAL POP MOV R2,R4 ADD #60,R4 JSR PC,PUTCHR BITB BITM(R2),GL1+6 ;CHECK FOR GLOBAL NEED BNE RET3 ;NOT NEEDED BISB BITM(R2),GL1+6 ;SET DONE FLAG JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL RET3: JSR PC,OUTNAM JSR PC,EOL RET2: MOV #RET,R4 ;NOW GENERATE JSR PC,PUTNAM BITB BITM+2,MISC ;DID WE GENERATE A GLOBAL YET BNE RET1 ;YES BISB BITM+2,MISC JSR PC,OUTGL ;GENERATE THE3MISC+6 ;IN THE COMPILER ZEROED ZREA BNE 1$ ;BR IF NOT NEEDED BISB BITM+6,MISC+6 ;FLAG DONE MOV #BEGBIT,R2 ;START HERE 2$: CLR (R2)+ ;AND CLEAR CMP R2,#ENDBIT ;TO HERE BLO 2$ 1$: MOV @R0,R2 ;FIND INITIAL TYPE CALL SAVCVT MOV CONVRT,CURTYP ;AND MAKE CURRENT TYPE MOV (SP)+,R2 ;RETURN ADDRESS OFF STACK MOV POLPTR,-(SP) ;FOR RETURNING ON EXIT MOV SP,FAILSP ;FOR FATAL EXITS CALL DUMP MOV #STK,R0 MOV R0,STKEND ;TO CHECK FOR STACK OVERFLOW ADD #STKSIZ,R0 MOV R0,STKPTR CLR @R0 4 ;NO ARGUMENTS CURRENTLY ASF291: TRAP+94. ;"MISSING, OR )" BR ASF299 ASF292: TRAP+95. ;"MISSING = IN ASF" BR ASF299 .NLIST BEX ; ; BUNCHES OF TEXT ; ASFT02: .BYTE ':,TAB,'J,'S,'R,TAB .ASCII '%4,$POLSH' .BYTE CR,LF,0 ASFT03: .BYTE TAB,'$,'P,'O,'P,'R,0 ASFT04: .BYTE CR,LF,TAB .ASCII '.GLOBL $RETA' .BYTE CR,LF,TAB .ASCII '$RETA' .BYTE CR,LF,0 TAB=11 LF=12 CR=15 .EVEN .END 5)+ MOV (R0)+,(R2)+ BR COMM04 ;ONTO VARIABLES. ; ;NAMED COMMON ;COLLECT NAME INTO ARRAY 'BLKNAM' ; COMM03: MOV #BLKNAM,R5 ;WHERE TO COLLECT NAME CLR BLKNAM CLR BLKNAM+2 CLR BLKNAM+4 JSR PC,GETID ; JSR PC,CNXC CMPB #'/,(R1)+ ;ADVANCE R1 TOO BEQ COMM04 ;BR => NAME OKAY TRAP+9. ;CLOSING "/" MISSING ON BLOCK NAME ;NOW HAVE BLOCK NAME IN 'BLKNAM' ;SEARCH FOR A BLOCK HEADER CONTAINING THIS NAME ; COMM04: MOV #COMHED,R2 ;CHAIN OF BLOCK NAMES MOV #1,R4 ;COMMON BLOCK COUNTER BR C6 GLOBAL JSR PC,EOL RET1: JSR PC,OUTNAM JSR PC,EOL .GLOBL ROUTIN TST ROUTIN ;IS THIS A MAIN PROGRAM? BNE RCCOM ;NO TRAP+113. ;YES, RETURN NOT ALLOWED BR RCCOM RET: .ASCII / $RET/ .BYTE 0 RETPOP: .ASCII / $POPR/ .BYTE 0 .EVEN .END 7 TST -(R0) MOV R0,STKBEG ;FLOATING BASE OF STACK MOV R0,STKRBS ;REAL BASE OF STACK JMP @R2 ; ; EXIT FROM THIS MODULE IN NORMAL FASHION ; EXIT: MOV (SP)+,R0 ;RESTORE R0 MOV TEXTR1,R1 ;BE POLITE ABOUT TEXT POINTER CLR LHSPOL ;DON'T LEAVE THIS FOR NEXT TIME RETURN ; ; DISPCH - DISPATCH ON INPUT ; DSPTCH: CALL CLSFY CALL NEWST CALL TRACE DSPTLP: MOV (R1)+,R2 BNE 1$ CALL ERR205 ;COMPILER ERROR 1$: CMP R0,R2 ;MATCH BEQ 2$ TST (R1)+ FOM11 COM12: MOV R0,R2 INC R4 ;UP BLOCK COUNTER COM11: MOV @R2,R0 ;R2 POINTS AT PREVIOUS BLOCK BEQ COM10 ;BR => GO CREATE NEW BLOCK CMP 2(R0),BLKNAM BNE COM12 ;LOOK FURTHER CMP 4(R0),BLKNAM+2 BNE COM12 ;LOOK FURTHER CMP 6(R0),BLKNAM+4 BNE COM12 ;LOOK FURTHER ;BLOCK MATCHES - SET UP TO ADD NEW SUBBLOCKS ADD #12,R0 ;GET LINK TO FIRST SUBBLOCK COMM10: TST @R0 BEQ COM101 ;NEW ITEM LINKAGE POINT IN R0 MOV @R0,R0 BR COMM10 COMX02: BR COMM02 ;ADD A NEW BLOCK NAME COM10: MOE ;ADVANCE BR DSPTLP ;TRY AGAIN ; 2$: CALL @(R1)+ TST EXTFLG BEQ DSPTCH CLR EXTFLG RETURN ; ;NEW STATE COMPUTATION ; NEWST: MOV STKBEG,R1 SUB STKPTR,R1 ADD #2,R1 ASR R1 ;NOTE LOGICAL DEPTH FOR TRACE MOV R1,STKDTH ASL R1 CMP #4,R1 BGE 1$ MOV #4,R1 1$: MOV STATAB(R1),R1 MOV R1,STATE RETURN ; ; RECURSE ON DSPTCH ; ; THE CURRENT STACK BASE IS PUSHED DOWN ; AND THE CURRENT CONTEXT ESTABLISHED ; AS NULL ; DSPREC: MOV STKBEG,-(SP) MOV STKPTR,R0 MOV R0,-(SP) ;C""""DDDD """"""""""""""""""""""""""""""""""""@DDDDDDDDDDDDDDDDDDDDDDDD@DD@DDDD@D@DD """"@DDDD """"@DDDD "DDDDDD""""""""""""""""33DL@DDDDDDDDDĈADDB C%d &d ; kQ > kQ  4? SkQ ",kQ MQ%SkQ n!8 *`"kQ &6<@kQ FG$:KkQ H|u:kQ XkQ  ^p:kQ /!kQ t!fkQ D#gt!ykQ ""[MkQ ""fkQ  @#kQ  2#"kQ 6B'|QkQ D(WkQ FZE,ekQ U y,l  aʋaՀ$ & * P$ ΋Ί   ΋   d Ί  ( 1'u  Q$f $5@ U C΋ Cb M΋U@ U &  B" .&0 IURRENT POINTER CLR -(R0) ;PUT "MARKER" ON STACK MOV R0,STKPTR ;NEW POINTER TST -(R0) ;NEW STACK BASE MOV R0,STKBEG TST DMPFLG ;TRACING? BEQ 1$ ;NO CALL OUTLN2, 1$: CALL DSPTCH TST DMPFLG BEQ 2$ CALL OUTLN2, 2$: ; RESTORE TO THE PREVIOUS STACK LEVEL AND ; COPY ANY STACK FROM THIS LEVEL UP TO BE ; COMPACK WITH PREVIOUS STACK MOV (SP)+,R4 ;PREVIOUS STACK POINTER MOV STKBEG,R3 ;BASE AT THIS LEVEL TST (R3)+ ;PRE-FUDGE FOR COPY LOOP 4$: CMP STKPTR,R3 ;ANY TJV #6,R0; GET SPACE FOR NEW COMMON HEADER JSR PC,FRDOWN; BCS COMEND; NO SPACE - "TABLE OVERFLOW" MOV R0,@R2 ;LINK FROM PREVIOUS BLOCK CLR (R0)+ ;CLEAR LINK TO NEXT BLOCK MOV #BLKNAM,R3 MOV (R3)+,(R0)+ ;MOVE NAME INTO BLOCK BODY MOV (R3)+,(R0)+ MOV (R3)+,(R0)+ CLR (R0)+; ZERO TERMINATOR FOR ASCII NAME CLR @R0; SET SUBBLOCK LINK=0 ;R0 CONTAINS ADDRESS OF LINK POINT COM101: MOV R0,-(SP); SAVE LINK POINT MOV #2,R0; 2 WORDS NEEDED FOR NEW SUBBLOCK JSR PC,FRDOWN; GET SPACE FOR NK .TITLE DATA .IDENT /0612/ ;RFB,LP ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY R. BRENDER ; ; ; HANDLING OF DATA STATEMENTS MUST ; FOLLOW ALL OTHER SPECIFIICATION STMTS ; ;STEP 0 - IS THIS REALLY A DATA STATEMENT? ; ASSUME YES IF A ZEROTH LEVEL COMMA ; IS FOUND. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL FAKSYM,DATTYL .TITLE DECLAR .IDENT /070501/ ;DK,RG,PJK ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. .GLOBL GETLN,SCANNR,SCAN18 .GLOBL MAIN,HDR,BLKDAT,BLKD,HDRGEN .GLOBL SCAN2A,GETSW,SEQNO,ENDFND .GLOBL ENDPRO,ASF,EXECUT,LINENO .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; SCANNR IS THE MAIN CONTROL LOOP FOR THE COMO MOVE? BHIS 5$ ;NO MOV -(R3),-(R4) BR 4$ 5$: MOV R4,STKPTR ;NEW STACK TOP MOV (SP)+,STKBEG RETURN ; PDWN: .ASCIZ /;CONTROL STACK PUSH DOWN/<15><12> PPUP: .ASCIZ /;CONTROL STACK POP/<15><12> .EVEN ;CLASSIFY: ; ; INPUT - POLPTR CONTAINS ADDRESS OF INTERNAL STRING ; ; ; CLASSIFY ITEM INTO ONE OF THE CASES ; ;R0= PSH. -NORMAL PUSH ; PAR. -PARAMETER PUSH ; ARY. -START OF ARRAY ; COM. -COMMA ; SVS. -SVSP ; FNC. -START OF FUNCTION ; CAL. -FNULL SUBBLOCK BCS COM91A; NO SPACE - "TABLE OVERFLOW" CLR (R0)+; SET 0 TERMINATOR FOR SUBBLOCK CLR @R0; SET 0 LHNK TO NEXT MOV R0,@(SP)+; LINK SUBBLOCK TO CHAIN MOV R4,COMNUM ;SAVE BLOCK NUMBER ;COLLECTING IDENTIFIER COM20: MOV #LOCADB,R2 ;PUT ADB HERE FOR NOW JSR PC,LSTITM ;HANDLE LIST ITEM BNE COM90 ;IF AN ERROR - SKIP FORWARD BIT ADJWD(R3),#ADJMKM BNE COM92 .GLOBL PARMKM,PARWD BIT #PARMKM,PARWD(R3) ;IS IT A PARAMETER? BNE COM92 ;YES,OP,DATVST,BITM,MISC,PACK00 .GLOBL GNTR$S,GNTL$S DATA: JSR PC,ZLEQLS ;LOOKS FOR COMMAS TOO! BCC DATA01 SEV RTS PC ; DATA01: MOV R1,-(SP) ;SAVE R1 AROUND ALOCAT JSR PC,ALOCAT MOV (SP)+,R1 ;RESTORE TEXT POINTER INCB GETSW ;SO THAT 'NOCNSV' CONTROLS ;CONSTANTS GETTING STORED TSTB BLKDAT ;SKIP TRANSFER IF BLOCK DATA BNE DATA03 JSR PC,GNTR$S ;$TR,$SNNNN IF NEEDED DATA03: MOV R1,R0 ;REMEMBER CURRENT TEXT DATA02: MOVB (R1)+,R2 ;FIND FIRST / BEQ DATA90 ;BR=>NO / CMPB #'/,R2 BPMPILER. IT CALLS ; GETLN FOR A LINE OF TEXT AND THEN DISPATCHES TO ; THE PROPER STATEMENT HANDLER. ; ; EACH STATEMENT HANDLER IS DISPATCHED TO BY A "JSRPC,XXX". ; UPON ENTRY TO THE HANDLER, R1 POINTS TO THE CHARACTER ; WHERE THE RECOGNITION SCAN LEFT OFF. ; ; EACH HANDLER IS, IN GENERAL, RESPONSIBLE FOR COMPLETE ; PROCESSING OF THE REMAINDER OF THE LINE, UP TO AND ; INCLUDING THE TERMINATOR BYTE. ; ; RETURN FROM THE HANDLER IS AS FOLLOWS: A NORMAL ; RETURN WILL RETURN USING A "RTS PC" WITH QUNCTION CODE PROPER ; CVT. -CONVERSIONS ; UOP. -UNARY OP ; BOP. -BINARY OP (NOT OPTIMIZABLE) ; OOP. -OPTIMIZABLE OP TO STACK ; TOP. -OPTIMIZABLE OP + ASSIGN ; END. -END OF POLISH STRING ; ; NOTES: ; SIDE EFFECTS: ; 1. CONVERSIONS ARE FACTORED OUT OF INT. POLISH. ; IF FOUND MUST BE REPORTED AT NEXT CLASSIFY CALL ; 2. DETERMINATION OF OPTIMIZABLE DEPENDS ON OPTLVL SWITCH ; 3. OOP BECOMES TOP IFF NO CONVERSION & FOLLOWED BY END. ; ; 4. FOR CERTAIN RETURNS, 'WORKI' IS ALSO SET AS FOLLR ERROR BIT #COMMKM,COMWD(R3) ;TEST FOR ALREADY IN COMMON BNE COM93 BIS #COMMKM,COMWD(R3) ;FLAG AS BEING IN COMMON MOVB COMNUM,COMNWD(R3) ;RECORD BLOCK NUMBER TST R2 BEQ COM30 ;SIMPLE VARIABLE ;HAVE A DIMENSIONED VARIABLE JSR PC,QADBOK ;CHECK THIS ADB & USE IF OKAY BVS COM90 ;BR=>SOME ERROR ;AT THIS POINT ALL IS WELL - USE THIS LIST ITEM COM30: MOV #1,R0; ADD 1 ENTRY TO SUBBLOCK JSR PC,FRDOWN; GET MORE SPACE BCS COMEND; NO SPACE - "TABLE OVERFLOW" SUB SYMBAS,R3; CONVERT TO SYMBSNE DATA02 ;BR=>KEEP LOOKING ;R1 NOW POINTS TO BEGINNING OF CONSTANTS JSR PC,DATA10 ;DO GROUP DEFINED BY R0,R1 TSTB @R1 ;CHECK FOR EOL BEQ DATA92 ;BR=>ALL DONE ON THIS LINE JSR PC,CNXC ;NEXT NON-BLANK UNDER R1 TSTB @R1 ;END OF LINE AFTER BLANKS? BEQ DATA92 ;YES, IT IS LEGAL CMPB #',,@R1 ;TEST FOR OPTION COMA DELIMITER BNE DATA03 ;NO PRESENT, KEEP GOING INC R1 ;PRESENT, SKIP IT AND BR DATA03 ;KEEP GOING ;NORMAL FINISH DATA92: JSR R5,OUTLN2 ;PUT OUT CSECT MESSAGE DATT01 TTTHE V-BIT ; OF THE STATUS WORD CLEAR. A RETURN WITH THE V-BIT ; SET MAY ONLY OCCUR IF THE LINE IN QUESTION COULD ; NOT BE OF THE ASSUMED TYPE. ; ; EXAMPLE: COMMON=1 IS A LEGAL STATEMENT, BUT ; THE COMMON PROCESSOR WOULD FIND IT ; UNRECOGNIZABLE SO THE PROCESSOR WOULD SET THE ; V-BIT BEFORE RETURNING. ; ; THE IMPLICIT AND TYPE PROCESSORS ARE ENTERED ; AS ABOVE EXCEPT THAT R0 CONTAIS THE MODE OF ; THE IMPLICIT OR TYPE STATEMENT ; REGISTERS CHANGED - ALL. ; EXSTM: JSR PC,CKMAIN ;DO A HEAUOWS: ; R0 WORKI ; -- ----- ; PSH SERIAL ; PAR. SERIAL ; CVT. CONVERSION TYPE ; ; 5. POLPTR POINTS TO CURRENT ITEM ON EXIT ; CLSFY: CALL CHKCVT BEQ QPOL CLR CONVRT MOV R0,WORKI MOV #CVT.,R0 RTS PC ;LOOK AT THE POLISH ITEM QPOL: MOV POLPTR,R1 ;ADDRESS TO USEFUL PLACE MOV @R1,R0 ;END? BNE 2$ ;NO MOV #END.,R0 ;YES RTS PC 2$: BMI CLSOP ;BR=> OPERATOR ;HAVE PUSH OR PARAMETER MOV R0,R2 ;GET CONVERSION CODE JSR PC,SAVCVT ;SAVE IT VOL TABLE INDEX CLR (R0)+; KEEP 0 TERMINATOR IN SUBBLOCK MOV R3,@R0; INSERT NEW ENTRY IN SUBBLOCK ;ARE THERE MORE LIST ITEMS? COM31: JSR PC,NXTCH ;NEXT CHAR TO R2 TST R2 BEQ COMEND ;ZERO = > END OF STATEMENT CMPB #',,R2 ;,= > MORE TO COME IN THIS BLOCK BEQ COM20 CMPB #'/,R2 ;/ => A NEW BLOCK NAME COMMING BEQ COMX02 COM90: TRAP+42. ;"ILLEGAL SYNTAX" TSTB @R1 BEQ COMEND INC R1 BR COM20 ;TRY TO CONTINUE ; ; END OF COMMON STATEMENT ; PICK UP THE MARBLES AND GO HOME ; WSTB BLKDAT BNE DATA93 JSR PC,GNTL$S ;$SNNNN=. DATA93: CLRB GETSW ;RETURN TO PRE-DATA VALUE CLR FAKSYM CLV RTS PC ; ; .NLIST BEX DATT01: .ASCIZ '.CSECT' .LIST BEX .EVEN ; ; DATA90: TRAP+99. ;"OPENING / MISSING FROM DATA GROUP" BR DATA92 ; THERE ARE THREE MAJOR CASES OF INTEREST. ; ; 1. BLOCK DATA ; A. ONLY NAMED COMMON CAN BE INITIALIZED ; B. ALLOCATION ALREADY DONE BY ALOCOM ; ; ; 2. NON-COMMON, PREVIOUSLXDING JUST IN CASE JMP EXECUT ;GO DO THE EXECUTABLES END00: CLR LINENO TRAP+39. ;MISSING END STATEMENT END01: JSR PC,CKM1 ;FORCE A HEADER IF NEEDED JMP ENDPRO ;LINKAGE TO END HANDLER SCANNR: CLRB GETSW ;NO, CLEAR GET SWITCH JUST IN CASE SCANR: CMP ERRCUR,#ERRS ;ANY ERRORS IN THE STATEMENT? BEQ SCANR1 ;NO JSR PC,SYN3ER ;PRINT THEM .GLOBL SYN3ER,ERRCUR,ERRS SCANR1: TSTB ENDFND; TEST IF 'END' ALREADY SEEN BNE END01; YES - GO TO ENDPRO INC SEQNO ;ADVANCE SEQUENCE NUMBER JSR PC,GYMOV R0,R2 ;GET TYPE OF VAR CALL GETTYP MOV R0,CURTYP CALL CHKCVT MOV @POLPTR,R1 BIC #170000,R1 MOV R1,WORKI MOV CURSYM,R0 BIT #PARMKM,PARWD(R0) BNE 3$ ;HAVE PARAMETER MOV #PSH.,R0 RTS PC 3$: MOV #PAR.,R0 RTS PC ; ;DECODE OPERATORS ; CLSOP: CMP #STRARY,R0 BNE 4$ MOV #ARY.,R0 RTS PC 4$: CMP #STRFNC,R0 BNE 5$ MOV #FNC.,R0 RTS PC 5$: CMP #COMMAC,R0 BNE 6$ MOV #COM.,R0 RTS PC 6$: BIC #377,R0 CMP #SVSPCD,R0 BNE 7$ MOV #SVS.,R0 RTS PC 7$: CMP #1020Z COM91A: TST (SP)+; DELETE STACK ENTRY COMEND: CLV RTS PC COM92: TRAP+44. ;"PARAMETER USED IN COMMON/EQUIVALENCE" BR COM31 COM93: TRAP+45. ;"VARIABLE ALREADY IN COMMON" BR COM31 ; ;CALLED TO ALLOCATE FREE SPACE FOR COMMON/EQUIVALENCE ;REGISTER USAGE: ;R0 CONTAINS NUMBER OF WORDS REQUESTED ;RETURNS: C=0, R0=NEW (LOWER) VALUE OF FRHIGH ; C=1, TABLE OVERFLOW ERROR, NO SPACE ALLOCATED ; FRDOWN: ASL R0; CONVERT ARGUMENT TO BYTE COUNT NEG R0; ADD FRHIGH,R0; MOVE FRHIGH DOWN SUB [Y ALLOCATED ; ; 3. NON-COMMON, YET TO BE ALLOCATED ; ; THE DESIRED FORMS ARE THE FOLLOWING: ; ; CASE I: ; ; .CSECT BLOCKNAME ; . =VARIABLE+OFFSET ; .WORD INITIALVALUE ; ; CASE II: ; ; $L000N =. ; . =VARIABLE+OFFSET ; .WORD INITIALVALUE ; . =$L000N ; ; CASE III ; ; VARIABLE =. ; . =VARIABLE+OFFSET ; .WORD INITIALVALUE ; . =VARIABLE+DECLAREDSIZE ; ; ; DATA10 ; ;INPUT: R0 - BEGINNING OF VARIABLE NAME TEXT ; R1 - BEGINNI\ETLN ;GET A LINE OF TEXT BVS END00 ;ASSUME END IF EOF OR EOM TST BLKDAT ;IS THIS ROUTINE ONLY BLOCK DATA?? BEQ SCAN1 ;NO ; MOV #BDATA,R0 ;PROTOTYPES ALLOWED IN BLOCK DATA BR SCAN3 SCAN1: MOV #NEXTBL,R0 ;NON-EXECUTABLE PROTOTYPES SCAN3: JSR PC,SCAN2A ;GO SEARCH FOR VERB BVS SCAN12 ;NOT FOUND TST BLKDAT ;IS THIS BLOCK DATA?? BNE SCAN5 ;JUMP IF YES CMP R0,#NXTBL1-NEXTBL ;SEE IF TYPE DECL. BGE SCAN7 ;IT GETS SPECIAL HANDLING JSR PC,CKMAIN ;GO SEE IF MAIN PROGRAM HEADER NEEDED ]00,R0 ;FUNCTION CALL PROPER? BNE CLSOP1 MOV #CAL.,R0 RETURN CLSOP1: MOV @POLPTR,R0 MOV R0,R2 ;NOTE CONVERSION IF NEEDED CALL SAVCVT CALL CHKCVT MOV @POLPTR,R0 BIC #177700,R0 MOV R0,WORKI ;FOR TRACING MOV R0,CUROPR CMP #OP.NOT,R0 ;.NOT. BNE 8$ 9$: MOV #UOP.,R0 RTS PC 8$: CMP #OP.NEG,R0 ;UNARY- BEQ 9$ ;IS A BINARY OPERATOR TST OPTLVL BEQ 11$ CMP #OP.A,R0 BLE 10$ ;MIGHT BE OPTIMIZABLE 11$: MOV #BOP.,R0 RTS PC 10$: CMP #OP.D,R0 BLT 11$ ; ;HAVE ONLY BINARY +^#20,R0; KEEP A "YELLOW ZONE" BELOW TABLE CMP R0,FRLOW; CHECK FOR TABLE OVERFLOW BLOS FRDWN0; ERROR - "TABLE OVERFLOW" ADD #20,R0; CORRECT VALUE FOR FRHIGH MOV R0,FRHIGH; UPDATE VALUE FOR FRHIGH CLC ; CLEAR ERROR FLAG RTS PC; RETURN WITH FRHIGH IN R0 ; FRDWN0: TRAP+43.; "TABLE OVERFLOW" SEC ; SET ERROR FLAG RTS PC; AND RETURN ;CALLED AT END OF DECLARATIONS ; ;REGISTER USAGE: ;R0-FOLLOWS BLOCK CHAIN ;R1-FOLLOWS SUBBLOCK CHAIN ;R2-FOLLO_NG OF CONSTANTS TEXT ; ;DO THE ENTIRE DATA GROUP UP TO THE CLOSING /. ; CON=0 TXT=2 DATA10: MOV R0,-(SP) ;WILL BE CALLED TXT(SP) MOV R1,-(SP) ;WILL BE CALLED CON(SP) CLR DATTYP ;TYPE OF A VARIABLE CLR DATVCT ;VARIABLE COUNTER CLR DATCCT ;CONSTANT REPEAT COUNTER ;DO VARIABLE PART DATA12: MOV TXT(SP),R1 JSR PC,DATVAR ;DO VARIABLE ITEM BCS DATA20 ;BR=>BAIL OUT JSR PC,CNXC MOV R1,TXT(SP) MOV CURSYM,R3 MOV DATYWD(R3),DATTYP ;REMEMBER TYPE WORD ;DO CONSTANT PART MOV (SP),R1 ` JSR PC,@NEXJMP(R0) ;JUMP TO NON-EXECUTABLES SCAN13: BVC SCANNR BR SCAN14 SCAN5: CMP R0,#NXTBL1-BDATA ;CHECK FOR TYPE DECLARATION BGE SCAN20 ;JUMP IF IT IS ADD #BJMP,R0 ;FUDGE THE POINTER JSR PC,@(R0)+ ;GO PROCESS STATEMENT BVC SCANR ;RETURN TO LOOP BR SCAN15 ;OR GIVE ERROR SCAN20: SUB #NXTBL1-BDATA,R0 ;FUDGE THE MODE POINTER BR SCAN21 ;ASSUME "TYPE" SCAN12: JSR PC,CKM1 ;SEE IF HEADER NEEDED SCAN14: TST BLKDAT ;CHECK FOR BLOCK DATA BNE SCAN15 ;DON'T CHECK ASF IF BLOCK DATA a - * / LEFT ; MOV CURTYP,R1 CMP #TYP.I,R1 BGT 11$ ;BOP. CMP #TYP.D,R1 BLT 11$ ;NOW CONSIDER THE IMPACT OF OPT LEVEL SWITCH ;REAL/DOUBLE ONLY IF OPT LEVEL =3 CMP R1,#TYP.R ;REAL REQUIRES LEVEL 3 BLT 12$ CMP #3,OPTLVL BNE 11$ ;NOPE - BOP. BR ISOOP ;IS OPTIMIZABLE ;INTEGER CASES 12$: CMP R0,#OP.M ;MUL/DIV REQUIRES LEVEL 2 BLT ISOOP ;+,-ALLOWED CMP #2,OPTLVL BGT 11$ ;BOP. ;ALL OPTIMIZABLE CASES COME TOGETHER HERE ;IS THERE AN END FOLLOWING? ISOOP: MOV POLPTR,R0 bWS ITEMS WITHIN SUBBLOCK ; ;ALLOCATE COMMON STORAGE SIZE = 0 ;ACCUMULATE CSECT SIZE ON STACK ALOCOM: MOV #COMHED,R0 ;GET FIRST BLOCK POINTER TST @R0 BEQ ALOC98 ALOC01: MOV @R0,R0 BEQ ALOC99 ;ZERO = > EXIT MOV 12(R0),R1 ;GET SUBLOCK BEQ ALOC01 ;ZERO = > GO TO NEXT BLOCK JSR PC,ALOC20 ;RETURN SIZE IN R3 ; ;ALLOCATE CSECT SIZE ; ALOC06: JSR R5,OUTLN2 ;".=.+" ALOC82 JSR PC,OUTOCT ;SIZE OF THIS CSECT (FROM ALOC01) JSR PC,EOL BR ALOC01 ;TRY FOR ANOTHER BLOCK ; ; ENcJSR PC,DATCON BCS DATA19 ;BR=>BAIL OUT JSR PC,CNXC MOV R1,(SP) JSR PC,DATVEN ;VARIABLE END-UP ;IS THERE MORE TO GO? ; ANY OF FOUR CONDITIONS MEAN THAT THERE IS ; MORE IN THIS GROUP: ; 1. A COMMA AFTER THE LAST VARIABLE ; 2. A COMMA AFTER THE LAST CONSTANT ; 3. A NON-ZERO REPEAT COUNT FOR A VARIABLE ; 4. A NON-ZERO REPEAT COUNT FOR A CONSTANT ; DATA11: CLR R0 TST DATVCT ;WILL REPEAT VARIABLE BNE DATA14 ;BR => YES CMPB #',,@TXT(SP) ;MORE VARIABLE BNE DATA13 ;dJSR PC,ASF ;GO TRY FOR ASF BVS EXSTM ;WASN'T ARITH. STMT. FNCT. BR SCANNR ;GO BACK FOR A LINE SCAN15: TRAP+4 ;BAD STATEMENT IN BLOCK DATA BR SCANR ; ; CKMAIN - SUBROUTINE TO CHECK FOR THE NEED OF A MAIN PROGRAM HEADER. ; IF ONE IS NEEDED, THE HEADER GENERATOR IS CALLED WITH ; THE NAME "MAIN." ; REGISTERS CHANGED - R4,R5. ; CKMAIN: CMP R0,#HDRN-NEXTBL ;IS THIS SUBROUTINE OR FUNCTION? BLE CK1 ;YES CKM1: TST HDR ;IS HEADER ALREADY DONE? BNE CK1 ;EXIT IF DONE MOV R0,-(SP) ;SAVE STe TST -(R0) ;CHECK NEXT WORD BNE 1$ TST CONVRT ;AT END-CONVERSION REQUIRED? BGT 1$ ;YES - THEN OOP. MOV #TOP.,R0 ;ELSE - TOP. RETURN 1$: MOV #OOP.,R0 RETURN ;SAVE CONVERSION FIELD FOR NEXT ENTRY ;R2 CONTAINS ITEM SAVCVT: SWAB R2 ASHR 4,R2 BIC #177770,R2 1$: MOV R2,CONVRT RTS PC ; ; CHECK FOR CONVERSION REQUIRED ; RETURN 0 IF NOT ELSE RETURN TYPE TO ; WHICH TO CONVERT ; CHKCVT: MOV CURTYP,R1 MOV CONVRT,R0 BEQ 1$ CMPB CHR(fDING COMES HERE ; ALOC99: JSR R5,OUTLN2 ;".CSECT" ALOC83 JSR PC,EOL ALOC98: RTS PC ;AND EXIT ; DO CSECT POINTED TO BY R0 ; ALOC20: CLR -(SP) ;COUNTER WITHIN CSECT BYTES JSR PC,OUTCST ; PUT OUT VARIABLE NAMES BR ALOC05 ALOC03: MOV @R1,R1 ;R2 POINTS TO SUBBLOCK ALOC05: MOV R1,R2 BEQ ALOC21 ;GO BACK FOR NEXT BLOCK ALOC04: MOV -(R2),R4; ADVANCE R2 AND GET ST LINK BEQ ALOC03 ;ZERO = > END OF SUBBLOCK MOV R0,-(SP) MOV R4,R0 ADD SgBR => NO INC TXT(SP) ;SKIP, DATA14: INC R0 ;FLAG MORE TO COME DATA13: TST DATCCT ;REPEAT CONSTANT BNE DATA15 ;BR => YES CMPB #',,@CON(SP) ;MORE? BNE DATA16 ;BR => NO INC CON(SP) ;SKIP , DATA15: INC R0 ;FLAG DATA16: TST R0 BNE DATA12 ;SHOULD BE AT THE END OF THE GROUP ;DID WE COME OUT EVEN? CMPB #'/,@TXT(SP) BNE DATA18 CMPB #'/,@CON(SP) BNE DATA18 ;NORMAL TERMINATION HAPPENS HERE ; DATA21: MOV CON(SP),R1 ;SET UP THE CONTINUATION POINT INC R1 ;SKIP OVER CLOSING / IN THIhATEMENT TYPE MOV R1,-(SP) MOV #MAIN,R1 ;GET ADDRESS OF "MAIN." MOV #MODNAM,R0 .GLOBL PACK00 JSR PC,PACK00 MOV #MODNAM,R0 JSR PC,HDRGEN ;CALL HEADER BUILDER CLR ROUTIN .GLOBL ROUTIN MOV (SP)+,R1 MOV (SP)+,R0 ;RESTORE STATEMENT TYPE CK1: RTS PC ;AND RETURN ; ; THIS CODE HANDLES QUICKLY FUNCTION CALLS WITH EXPLICIT ; TYPING. ; SCAN7: SUB #NXTBL1-NEXTBL,R0 ;FUDGE THE MODE POINTER MOV R0,-(SP) ;SAVE TYPE FLAG FOR LATER USE MOV #FNTBL,R0 ;CHECK FOR "FUNCTION". JSR PC,SCAN2A ;GiR0),CHR(R1) BNE 1$ CLR R0 CLR CONVRT 1$: RETURN .SBTTL OOPGEN: CENTRAL CODE OUTPUT GENERATOR ; ; INPUT -LTCOD,RTCOD,DSCOD ; -CURTYP,CUROPR ; ; OPERATION: ; NAME OF POLISH OPERATOR IS FORMED ON STACK ; AND QGLOB CALLED FOR .GLOBL STATEMENT IF NEEDED. ; SPECIAL CASE HANDLING OCCURS FOR LTCOD, IE., ; COD.C MAYBE CHANGED TO COD.K OR COD.1. ; THEN THE OPERATOR AND ARGUMENTS ARE OUTPUT ; OOPGEN: SAVREG SUB #8.,SP ;MAKE ROOM FOR NAME MOV SP,R1 jYMBAS,R0 JSR PC,OUTST ;OUTPUT SYMBOL NAME FROM ST MOV (SP)+,R0 JSR R5,OUTLN2 ALOC80 MOV @R2,R4 JSR PC,SIZESN ;RETURN SIZE OF SYMBOL IN R4 MOV (SP),R3 ;FOR OUTOCT ADD R4,(SP) ;UPDATE ACCUMULATED SIZE OF THIS CSECT JSR PC,OUTOCT JSR PC,EOL BR ALOC04 ALOC21: MOV (SP)+,R3 ;RETURN TOTAL SIZE SO FAR RTS PC ; ; ALOXXX ; ; COMPUTE THE BEGINGING OF AN ELEMENT OF A COMMON ; BLOCK FROM THE BASE OF THAT BLOCK ; ;*****(SHOULD BE COMBINED WITH kS GROUP DATA17: ADD #4,SP RTS PC ; ; DATA18: TRAP+100. ;"UNEQUAL NUMBER OF VARIABLES & CONSTANTS." DATA19: CLRB @R1 ;FAKE EOL AFTER ERROR BR DATA17 ;HAVE ERROR ON CONSTANT - CHECK FOR SHORT FILLING AN ARRAY DATA20: CMPB #'/,@R1 ;NORMAL END OF CONSTANTS BNE DATA18 CMPB #'/,@TXT(SP) ;ALSO END IF ARRAY BNE DATA18 CLR DATVCT JSR PC,CNXC MOV R1,CON(SP) JSR PC,DATVEN BR DATA21 ; DATVAR ; ;GENERATE VARIABLE NAME PART ;INPUT: R1 - TEXT DAlO SEE IF PRESENT BVC SCAN9 ;IT WAS THERE MOV (SP)+,R0 ;IT WASN'T, SO IT IS "TYPE". SCAN21: JSR PC,CKM1 ;SET UP HEADER IF NEEDED ASR R0 MOVB MODE(R0),R0 JSR PC,TYPE ;GO PROCESS TYPE BR SCAN13 SCAN9: MOV (SP)+,R0 ;GET TYPE OF FUNCTION CALL ASR R0 ;GET THE MOVB MODE(R0),R0 ; SELECTED MODE JSR PC,FUNCTO ;AND GO TO SPECIAL FUNCTION ENTRY BR SCAN13 ; ; IMPLICIT PROCESSING OCCURS HERE ; SCAN18: MOV #NXTBL1,R0 ;GET ADDRESS OF TYPE LIST JSR PC,SCAN2A ;GET THE TYPE DECLARATION BmMOVB #'$,(R1)+ ;$ MOV LTCOD,R2 ;MAY BE NULL BEQ 1$ MOVB CODLET(R2),(R1)+ 1$: CALL ISIC ;SPECIAL CASES MOV RTCOD,R2 BEQ 2$ MOVB CODLET(R2),(R1)+ 2$: MOV DSCOD,R2 ;NEVER NULL MOVB CODLET(R2),(R1)+ MOV CUROPR,R2 MOVB OPRLET(R2),(R1)+ MOV CURTYP,R2 MOVB TYPLET(R2),(R1)+ CLRB (R1)+ ;TERMINATOR MOV SP,R0 CALL QGLOB ;WORRY ABOUT .GLOBL ; ; NOW GENERATE THE OPERATION ; CALL OUTTAB MOV SP,R4 ;THE OPERATION CALL OUTLN1 MOV LTCOD,R1 ;LEFT ARGUMENT MOV LTARG,R0 CALL DnABOVE ROUTINE SINCE SO SIMILAR)***** ; ; INPUT - R0 = POINTER TO CSECT NAME IN COMMON TABLES ; R1 = STEX OF VARIABLE ; OUTPUT - R0 = DISPLACEMENT IN BYTES ; C-BIT =1 IF AND ONLY IF SOME ERROR ; ALOXXX: CLR -(SP) ;ACCUMULATE OFFSET HERE MOV 12(R0),R0 ;GET AT ITEMS IN BLOCK BR ALOX05 ALOX03: MOV @R0,R0 ;NEXT LINK BEQ ALOX09 ;ERROR - SHOULD NOT HAPPEN EVER!!! ALOX05: MOV R0,R2 ;COPY TO WORKING REG ALOX04: MOV -(R2),R4 ;STEX FROM COMMON BLOCK BEQ ALOX03 ;NOT REALLY - LOOKoTVAR: TST DATVCT ;ARE WE STILL ON AN ARRAY? BEQ DATV01 ;BR=>NO ;STILL ON VARIABLE - JUST DECREMENT COUNT AND EXIT DEC DATVCT MOV DATVSV,CURSYM ADD SYMBAS,CURSYM CLC ;NO ERROR RTS PC ;HERE WE START A NEW VARIABLE DATV01: MOV #LOCADB,R2 ;WHERE TO PUT ADB CLRB GETSW ;LSTITM REQUIRES GETSW=0 JSR PC,LSTITM ;GET LIST ITEM BNE DATV99 ;BR=>SYNTAX ERROR IN LSTITM INCB GETSW ;BACK TO DATA SETTING MOV R2,DATADB ;SAVE ADB ADDRESS (MAY BE ZERO) BIT ADJWD(R3),#ADJMKM ;MUST NOT BE ADJUpVC 1$ TRAP 3 ;TELL USER THAT TYPE IS BAD MOV #INTTBL-NXTBL1,R0 ;ASSUME HE MEANT INTEGER 1$: ASR R0 ;GET BYTE INDEX INTO MODE TABLE MOVB MODE(R0),R0 ;GET MODE IN R0 JSR PC,IMPLIC ;DO "IMPLICIT" RTS PC .NLIST BEX ; ; MODE TABLE TO MATCH ORDER OF N11 THRU N20. ; MODE: .BYTE 0,1,0,2,2,4,4,5,4,3,3 .EVEN ; ; TABLE OF NON-EXECUTABLE PROTOTYPES ; NEXTBL: N1 N2 HDRN: N10 N3 N3A BDATA: N5 N6 N7 N8 N9 N10A NXTBL1: N11 N12 N12A qOARG MOV RTCOD,R1 MOV RTARG,R0 CALL DOARG MOV DSCOD,R1 MOV DSARG,R0 CALL DOARG CALL EOL ADD #8.,SP ;RESTORE STACK RETURN ; ; ISIC -SPECIAL HANDLING IF RTCOD IS COD.C ; SUBSTITUTE COD.K OR COD.1 AS APPROPRIATE ; ; ; INPUT -RTCOD ; ; OUTPUT -UPDATE RTCOD,RTARG ; ISIC: SAVREG MOV RTCOD,R0 CMP #COD.C,R0 BNE 1$ ;NOT COD.C CMP #TYP.I,CURTYP ;MUST ALSO BE INTEGER MODE BNE 1$ MOV RTARG,R0 ;GET SERIAL # CALL SERATR ;LOOK UP SERr FOR LINK CMP R1,R4 ;MATCH YET? BEQ ALOX06 ;BR => NORMAL EXIT JSR PC,SIZESN ;INCLUDE THIS ELEMENT IN OFFSET ADD R4,@SP BR ALOX04 ; ALOX06: MOV (SP)+,R0 ;THE ANSWER CLC RTS PC ; ALOX09: TST (SP)+ ;CLEAR STACK SEC RTS PC ; GENERATE THE CSECT NAME ; R0 = POINTER TO COMMON BLOCK TABLE ; OUTCST: JSR R5,OUTLN2 ALOC81 MOV R0,R4 ADD #2,R4 ;POINTER TO NAME TEXT JSR PC,OUTLN1 JSR PC,EOL RTS PC ; ; SOME BITS AND PIECES OF TEXT ; .NLIST BEX ALOC80: .ASCII '=.+' .sSTABLE BNE DATV98 ;BR=>ERROR ;NOW WE GET DOWN TO CASES. ;IF A BLOCK DATA SUBPROGRAM - DATA CAN BE PUT ;ONLY IN NAMED COMMON. ;OTHERWISE DATA CAN ONLY BE PUT IN LOCAL VARIABLES- ;NOT IN UNNAMED COMMON AT ALL. TSTB BLKDAT BEQ DATV20 ;BR=>NOT BLOCK DATA ;THE BLOCK DATA SECTION MOVB COMNWD(R3),R4 BIC #177400,R4 ;GIVE BLOCK # CMP #1,R4 BGT DATV92 ;BR=>NOT NAMED COMMON MOV #COMHED,R0 ;GET COMMON BLOCK ITSELF DATV11: MOV @R0,R0 DEC R4 BNE DAt N13 INTTBL: N14 N15 N16 N17 N18 N19 N20 N21 0 ; END OF PART 1 ; ; START OF PART 2 N1: .ASCII /SUBROUTINE/ N2: .ASCII /FUNCTION/ N10: .ASCII /BLOCKDATA/ N3: .ASCII /EXTERNAL/ N3A: .ASCII /DEFINEFILE/ N5: .ASCII /DIMENSION/ N6: .ASCII /COMMON/ N7: .ASCII /EQUIVALENCE/ N8: .ASCII /DATA/ N9: .ASCII /IMPLICIT/ N10A: .ASCII /END/ N11: .ASCII /LOGICAL*1/ N12: .ASCII /LOGICAL/ N12A: .ASCII /BYTE/ N13: .ASCII /INTEGER*2/ N14: .ASCII /INTEGER/ N15: .ASCII /DOUBLEPRECISION/ N16uIAL MOV CURSYM,R0 ;GET SYM TAB POINTER BIT #CONMKM,CONWD(R0) ;CONSTANT? BEQ 1$ ;NO MOV VALUE(R0),R0 ;GET VALUE MOV R0,RTARG ;UPDATE MOV #COD.K,RTCOD CMP #1,R0 ;BUT IS IT 1? BNE 1$ ;NO CMP #OP.M,CUROPR ;DON'T GIVE 1 CODE ON MUL/DIV BGT 2$ ;DO FOR ADD/SUB CMP #OP.D,CUROPR BGE 1$ ;ALSO FOR MOV 2$: MOV #COD.1,RTCOD 1$: RETURN ; ; DOARG - OUT PUT AN ARGUMENT AS APPROPRIATE ; TO ITS CODE ; ; INPUT -R1=CODE VALUE ; -R0=ARUMEvBYTE 0 ALOC83: .ASCII '.EVEN' ALOC81: .ASCIZ '.CSECT' ALOC82: .ASCIZ '.=.+' TAB=11 CR=15 LF=12 BLANKC: .ASCIZ '.$$$$.' .LIST BEX .EVEN ; SIZESM ; ;COMPUTE SIZE (IN BYTES) OF A DATA ITEM GIVEN ;IT SYMBOL TABLE ENTRY ;INPUT: (R4)= ADDRESS OF STE ; (R3)= ADB TO USE ;OUTPUT: (R4)= SIZE IN BYTES OF WHOLE VARIABLE ; (R5)= SIZE IN BYTES OF SINGLE ELEMENT ; C-BIT = 1 => ERROR, A SIZE OF 0 IS RETURNED ; C-BIT = 0 => ALwTV11 JSR PC,OUTCST ;OUTPUT "CSECT NAME" ;NEXT SET UP THE LOCAL PC. DATV22: MOV #DATV12,R4 JSR PC,OUTLN1 ;".=" MOV CURSYM,R0 JSR PC,DATV30 JSR PC,EOL ;NOW WE CAN GO BACK TO COMMON GROUND. BR DATV40 ; DATV98: JMP DATV91 DATV99: JMP DATV90 ;HERE CONSIDER THE RULES FOR NON-BLOCK DATA ; DATV20: TSTB COMNWD(R3) BEQ DATV21 TRAP+101. ;"DATA NOT ALLOWED IN COMMON AREAS" DATV21: BIT ALLOWD(R3),#ALLMKM BNE DATV25 ;BR=> ALL READY ALLOCATED ; x: .ASCII /DOUBLE/ N17: .ASCII /COMPLEX/ N18: .ASCII /REAL*8/ N19: .ASCII /REAL*4/ N20: .ASCII /REAL/ N21 = . .EVEN ; END OF PART 2 ; ; FUNCTION PROTOTYPE FOR SPECIAL FUNCTION FORMS ; FNTBL: N2 N10 0 ; .GLOBL NEXJMP,BJMP,TYPE,FUNCTO,IMPLIC,BLOCKD ; ;THE JUMP TABLE FOR THIS ROUTINE IS INCLUDED IN ;THE PROGRAM OR OVERLAY HEADER ; ; ; BLOCK DATA IS EASY TO HANDLE SO IS DONE HERE ; BLOCKD: CMPB (R1)+,#' ;SKIP OVER BLANKS BEQ BLOCKD ;IF ANY TSTB -(R1) ;END OF LINE?? BEQ BLOCKyNT DATA ; DOARG: SAVREG ASL R1 ;FOR DISPATCH JMP @DOARGT(R1) DOARGT: +DOAN ;NULL CASE +DOAC ;CORE +DOAS ;STACK +DOAR ;R0 ADDRESS +DOAF ;F0 CONTENTS +DOAG ;R0-R3 CONTENTS +DOAP ;PARAMETER OFFSET +DOAA ;ADB REFERENCE +DOAK ;CONSTANT +DOA1 ;LITERAL 1 +DOAB ;ARRAY BASE + OFFSET +DOAD ;USE DESTINATION ; ; NO OUTPUT CASES ; DOAN: DOAS: DOAR: DOAF: DOAG: DOAD: DOA1: RETURN ; ; ADDRESS OF C ITEM ; DOAC: TST R0 ;ONLY ARRAYS PASS 0 CORE ITEM BEQ DOA1 ;AND EXPECT NO AzL OKAY ; SIZESM: MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) JSR PC,SIZSIZ ;GET DATA SIZE IN BYTES IN R0 MOV R0,R5 ;WILL RETURN AS RESULT TST R3 BNE SIZES1 ;BR => HAVE ONE ADB ;HAVE A SIMPLE VARIABLE NAME SIZES9: MOV R0,R4 ;RETURN VALUE HERE CLC SIZES8: MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ;EXIT ;WORRY ABOUT ADB SIZES1: JSR PC,SIZDIM ;GET WORD WITH # DIMENSIONS BEQ SIZES9 ;USED BY EQUIVALENCE-JUST RETURN ITEM SIZE ADD #4,R3 ;POINT TO FIRST DIMENSION LIMIT ;READY T{ ;HERE ALLOCATE THE DATA ITEM ; BIS #ALLMKM,ALLOWD(R3) ;SET ALLOCATED BIT MOV R3,-(SP) ;SAVE AWAY TIL WINTER COMES MOV R3,R0 JSR PC,OUTST ;SYMBOL NAME MOV #DATV23,R4 JSR PC,OUTLN1 ;"=..=" MOV (SP)+,R0 JSR PC,DATV30 JSR PC,EOL BR DATV40 ; ALLOCATED BUT NOT IN COMMON ; DATV25: JSR PC,SAV$PC ;$PC=. MOV #DATV26,R4 ;".=" JSR PC,OUTLN1 MOV CURSYM,R0 JSR PC,DATV30 JSR PC,EOL MOV FLABL,DATLAB INC FLABL BR DATV40 |2 ;YES TRAP+12. ;NO BLOCK2: INC BLKDAT ;DISALLOW EXECUTABLES MOV #BLKD,R1 ;GET ADDRESS OF "DATA." MOV #MODNAM,R0 .GLOBL MODNAM JSR PC,PACK00 MOV #MODNAM,R0 JSR PC,HDRGEN ;CALL HEADER BUILDER CLV RTS PC ;AND RETURN ; .END }RG CALL OUTCOM ;, CALL SERATR ;LOOK UP SYMBOL MOV CURSYM,R0 CALL OUTST ;OUTPUT NAME RETURN ; ; CONSTANT VALUE ; DOAK: CALL OUTCOM ;, MOV R0,R3 CALL OUTOCT RETURN ; ; ADB REFERENCE ; DOAA: CALL OUTCOM ;, MOV R0,R3 MOV R0,-(SP) MOV #'A,R0 CALL OUTSER MOV (SP)+,R0 CALL SERATR ;NEED TO SET ADB REFERENCED BIT MOV CURSYM,R2 BIS #PSHMKM,PSHWD(R2) RETURN ; ; PARAMETER OFFSET ; DOAP: CALL SERATR MOV CURSYM,R0 MOVB @R0,R0 ;***CHEATING WAY TO REFERNCE*** BR DOA~O LOOP SIZES2: MOV (R3)+,R1 JSR PC,IMULTI BCS SIZES7 ;OVERFLOW = > ERROR EXIT DEC R4 ;DECREASE DEMENSION COUNT BEQ SIZES9 ;NORMAL RETURN BR SIZES2 SIZES7: CLR R4 ;ERROR-CLEAR R4 & SET C-BIT SEC BR SIZES8 ;RESTORE STACK & RETURN ; ; SIZESN ; ; SAME AS SIZESM EXCEPT: ; 1) R4 = RELATIVE INDEX OF S.T.ENTRY ; 2) THE ADB IS TAKEN FROM THE S.T. ENTRY ; SIZESN: ADD SYMBAS,R4 MOV ADBPWD(R4),R3 ;ADB WORD BEQ SIZES5 ;LEAVE ZERO AS ZERO ADD SYMBAS,R3 SIZES5: BR SIZESM ;; ; ; DATV23: .BYTE TAB,'=,'.,CR,LF DATV26: .BYTE '.,TAB,'=,0 DATV12: DATV24: .BYTE '.,TAB,'=,0 .EVEN ;NOW THERE ARE THREE CASES ; 1-HAVE A SIMPLE VARIABLE (NOT AN ARRAY) ; 2-HAVE A SINGLE ELEMENT OF AN ARRAY ; 3-HAVE AN ENTIRE ARRAY DATV30: JSR PC,OUTST ;SYMBOL NAME MOV CURSYM,DATVSV ;REMEMBER ENTRY SUB SYMBAS,DATVSV ;AS AN OFFSET THAT IS MOV DATADB,R3 MOV R0,R4 BIT #DIMMKM,DIMWD(R4) ;DIMENSIONED? BNE DATV31 ;NOT DIMENSIONED => SIK ; ; ARRAY+OFFSET REFERENCE ; (CAN ONLY OCCUR ON SUBSCRIPT OPERATORS ; DOAB: CALL DOAC ;DOES THE ARRAY NAME CALL OUTCH2,<'+> MOV RTARG,R3 CALL OUTOCT RETURN .SBTTL OPTIMIZABLE THREE ADDRESS OPERATOR GENERATION ; ;OOP - OPTIMIZABLE CODE GENERATION ; OOP: CALL G2S CALL P2R CALL POP CALL POP CALL PSC MOV #COD.S,DSCOD MOV #EXPGBL,R3 ;EXPRESSION BIT MAP CALL OOPGEN SUB #2,POLPTR CALL PS RETURN ; ; TOP PROCESSING ; ; TOP: CM ; GET # DIMENSIONS FROM ADB ; SIZDIM: MOV 2(R3),R4 ROL R4 ROL R4 ROL R4 BIC #177774,R4 RTS PC ; ; SIZSIZ ; ; COMPUTE SIZE OF THE SYMBOL POINTED AT BY R4 ; RETURN VALUE IN R0 (IN BYTES) ; SIZSIZ: MOV DATYWD(R4),R0 BIC #DATYMK,R0 ;MASK TO TYPE ONLY SWAB R0 ;MOVE TYPE TO LOW BITS CLC ROR R0 ROR R0 ROR R0 MOVB TYPSIZ(R0),R0 ;LOOK UP SIZE IN TABLE RTS PC ; SIZESQ ; ; SIMILIAR TP SIZESM EXCEPT THAT AN ELEMENT ; SIZE OF OMPLE VARIABLE DATVC1: TST R3 BEQ DATV32 TRAP+102. ;"SUBSCRIPTS ON UNDIMENSIONED DATV32: RTS PC ; ;CASES 2 AND 3 ; DATV31: MOV CURSYM,R4 TST R3 BEQ DATVC3 ;BR => WHOLE ARRAY ; ;CASE 2: ELEMENT OF ARRAY ; DATVC2: MOV R3,-(SP) MOV R4,-(SP) MOV #'+,R4 JSR PC,OUTCHR MOV (SP)+,R4 MOV (SP)+,R3 JSR PC,SIZT BCC DATV33 ;BR=>SUBSCRIPTS OKAY TRAP+97. ;"SUBSCRIPTS OUT OF BOUNDS" DATV33: MOV R4,R3 SUB R5,R3 ;COMPENSATE FOR ELEMENT SIZE JSR PC,OUTOCT RTS PC ;CASE 3: WHOLE A .TITLE DEFINE .IDENT /0504/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY L. COHEN, D. KNIGHT ; ;DEFINE FILE PROCESSOR ;FORMAT: DEFINEFILE A(M,L,U,V) ;GENERATES: .GLOBL $DEFIL ; $DEFIL,#A,#M,#L,#V ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .CSECT .GLOBL DEFINE,CNXC1,OUTLN,GET .GLOBL OUTCOM,OUTST,ZLEQLS,CURSYM,VALUE .GLOBL SCANP STKBEG,STKRBS BNE 1$ TST LHSPOL BNE TOPYES CALL OOP ;NO LEFT HAND SIDE 1$: INC EXTFLG RETURN ; ; DO LEFT HAND SIDE STUFF ; TOPYES: MOV LHSPOL,POLPTR CALL DUMP CALL TOPCHK ;CHECK LEGALITY ; ; KEEP STACK ORDER RIGHT IF LHS IS AN ARRAY ; CALL LR0CHK ;CHECK IF LHS WILL GIVE BCC 2$ ;RESULT IN R0 - BR IF NOT CALL PSC BR 3$ 2$: CALL G2S CALL P2R 3$: CALL POP CALL POP MOV LTCOD,-(SP) MOV LTARG,-(SP) MOV RTCOD,-(SP) MOV RTARG,-(SP) MOV CUROPR,-(SP) ;SAVE OPERATORNE IS ASSUMED AND THE NUMBER OF ELEMENTS ; COMPUTED. (USED PRIMARILY BY DATA STATEMENTS) ; INPUT: R4 - ADDRESS OF SYMBOL TABLE ENTRY ; OUTPUT: R4 - NUMBER OF ELEMENTS ; REGISTERS CHANGED: R3,R4 ; SIZESQ: MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) MOV #1,R0 ;ASSUMMED BYTES/ELEMENT MOV ADBPWD(R4),R3 ;GET ADB ENTRY ADD SYMBAS,R3 ;ITS ADDRESS BR SIZES1 ;JUMP INTO THE ARRAY CASE CODE ; SIZT ; ; COMPUTE OFFSET OF A SUBSCRIPT AT COMPILE TIMERRAY DATVC3: JSR PC,SIZESQ ;GET # ITEMS DEC R4 MOV R4,DATVCT ;SAVE IN COUNTER RTS PC ;READY TO CLOSE SHOP ON THE VARIABLE DATV40: CLC RTS PC DATV91: TRAP+103. ;"ADJUSTABLE ARRAY NOT ALLOWED" DATV90: SEC ;INDICATE ERROR RTS PC DATV92: TRAP+104. ;"NAMED COMMON ONLY ALLOWED IN BR DATV90 ; BLOCK DATA SUBPROGRAM" ; DATVEN ; ; CALLED AT END OF CONSTANT TO CLOSE OFF VARIABLE ; DATVEN: TST DATVCT 2A,EOL,GENLAB,GNTR$X DEFINE: JSR PC,ZLEQLS ;IS THERE A 0-LEVEL = IN THIS LINE BCS DEF50 ;IF YES EXIT UNSUCCESSFUL JSR PC,GENLAB .GLOBL GETSW MOVB GETSW,-(SP) ;SAVE OLD SWITCH MOVB #1,GETSW ;SET IT TO 1 JSR PC,GNTR$X ;FLAG $TR,$SNNNN MAY BE NEEDED MOV #DEF90,R4 ;ELSE GENERATE GLOBL MOV #DEF93-DEF90,R5 JSR PC,OUTLN DEF010: MOV #DEF91,R4 MOV #DEF92-DEF91,R5 JSR PC,OUTLN JSR PC,GET ;GET THE A FIELD BVC DEF01 ;IF GET FOUND ERROR, RETURN DIAG. DEF011: TRAP +86. ;ILLEGAL SYNTAX TOPY1: CALL DSPREC ;RECUR ON DISPATCHER CALL P2R CALL TRACE CALL POP MOV LTARG,DSARG MOV LTCOD,DSCOD MOV (SP)+,CUROPR MOV (SP)+,RTARG MOV (SP)+,RTCOD MOV (SP)+,LTARG MOV (SP)+,LTCOD ; ; MAKE SURE THAT DISTINATION IS C OR R ; MOV DSCOD,R0 TSTB TOPT(R0) BNE 1$ MOV TEXTR1,R1 TRAP+21. 1$: CMP #COD.C,DSCOD BNE 2$ CMP #COD.C,LTCOD BNE 2$ CMP #TYP.I,CURTYP BNE 2$ CMP #OP.M,CUROPR BLE 2$ CMP LTARG,DSARG BNE 2$ MOV #COD.D,LTCOD 2$: ; ; ALL IS WELL - PUT ; INPUT: R4 = ADDRESS OF SYMBOL TABLE ENTRY ; R3 = ADDRESS OF PSEUDO-ADB GIVING THE SUBSCRIPTS ; OUTPUT: R4 = OFFSET IN BYTES ; R5 = NUMBERS OF BYTES IN A SINGLE ELEMENT ; C = 0 => ALL OKAY ; C = 1 => ERROR: EITHER SUBSCRIPTS EXCEEDED DIMENSIONS ; OR PRODUCT EXCEEDED 16 BITS ; SIZT: CLR -(SP) ;SET NOT OUT OF BOUNDS MOV R0,-(SP) ;SAVE MOV R1,-(SP) MOV R2,-(SP) MOV R4,-(SP) MOV R4,R1 ;FOR EQVBDS JSR PC,EQVBDS ;CHECK T BNE DATVE3 ;BR => STILL ON ARRAY BITB BITM+3,MISC+6 ;.=$PC NEEDED? BEQ DATVE1 ;BR IF NOT JSR PC,RES$PC ;.=$PC DATVE2: RTS PC ;(CASE I) ; DATVE1: MOV DATVSV,R0 ADD SYMBAS,R0 TSTB COMNWD(R0) ;COMMON OR NOT? BNE DATVE2 ;BR => IS COMMON: NO MORE NEEDED ; ; UNALLOCATED NON-COMMON ;(CASE III) ; MOV #DATVE9,R4 JSR PC,OUTLN1 ;"=" JSR PC,OUTST MOV #'+,R4 JSR PC,OUTCHR MOV DATVSV,R4 JSR PC,SIZESN MOV R4,R3 MOV R3,-(SP) JSR PC,OUTOCT JSR PC,EOL ROR (SP)+ BCC DA IN DEFINEFILE STATEMENT DEF11A: MOVB (SP)+,GETSW ;RESTORE GETSW CLV RTS PC DEF01: TST R3 ;IS A A CONSTANT? BMI DEF02 ;BR IF YES BGT DEF013 ;CAN'T BE AN ARRAY OR FUNCTION CMP R2,#2 ;IS VARIABLE TYPE = INTEGER ? BNE DEF013 DEF012: JSR PC,DEF60 ;WRITE A FIELD SYMBOL + COMMA CMPB (R1),#'( ;R1 SHOULD BE AT A "(" BNE DEF014 ;BR IF NOT JSR PC,CNXC1 ;ELSE STEP OVER THE LEFT PAREN JSR PC,GET ;GET M FIELD BVS DEF015 CMP R2,#2 ;IS VARIABLE TYPE = INTEGER ? BNE DEF015 JSR PC,DEF60 OUT THE LAST CODE ; MOV #EXPGBL,R3 ;EXPRESSION GLOBL BIT MAP CALL OOPGEN INC EXTFLG RETURN TOPCHK: MOV POLPTR,R5 MOV TEXTR1,R1 ;TEXT POINTER IN CASE OF ERROR MOV @R5,R0 BMI 1$ ; START WITH PSH. OR PAR. TST -2(R5) ;SHOULD END NEXT BEQ 2$ TRAP+21. 2$: CALL SERATR MOV TEXTR1,R1 TST R3 BGE 3$ TRAP+27. ;CAN'T ASSIGN TO CONSTANT 3$: CMP #2,R3 BNE 4$ TRAP+28. ;CAN'T ASSIGN TO FUNCTION 4$: CMP #1,R3 BNE 5$ TRAP+26. ;NON-ARRAY HAT SUBSCRIPTS IN BOUNDS BCC 1$ ;NOT OUT OF BOUNDS INC 10(SP) ;FLAG BAD SUBSCRIPT 1$: TST 2(R3) ;0 => NO ADB BEQ SIZT05 ;WHICH IS OKAY, VALUE IS ZERO MOV ADBPWD(R4),R5 ;GET ADDRESS OF REAL ADB ADD SYMBAS,R5 JSR PC,SIZDIM ;# DIMENSIONS (R3 IN,R4 OUT) MOV 4(R3),R2 ;FIRST SUBSCRIPT DEC R4 ;COUNTER OF DIMENSIONS BEQ SIZT01 ;BR IF SINGLE DIMENSION MOV 4(R5),R0 ;FIRST DIMENSION MOV 6(R3),R1 ;SECOND SUBSCRIPT DEC R1 JSR PC,IMULTI ;R0 TIMES R1 TO R0 BCS SIZT02 ;BR=>OVERFLOW ATVE3 JSR R5,OUTLN2 +TXTEVN DATVE3: RTS PC ; DATVE9: .BYTE '.,TAB,'=,0 .EVEN ; ; SAV$PC: JSR R5,OUTLN2 +SAV$PA BISB BITM+3,MISC+6 RTS PC ; RES$PC: JSR R5,OUTLN2 +RES$PA BICB BITM+3,MISC+6 RTS PC ; SAV$PA: .ASCIZ /$PC=./<15><12> RES$PA: .ASCIZ /.=$PC/<15><12> TXTEVN: .ASCIZ <11>/.EVEN/<15><12> .EVEN ; DATCON ; ;SUPPLY A CONSTANT FOR A DATA STATEMENT ; DATCON: TST DATCCT ;ARE WE REPEATING? BEQ DATC01 ;BR=> NO ;USE THE PREVIOUS ;WRITE M FIELD SYMBOL + COMMA CMPB (R1),#', ;NEXT INPUT CH SHOULD BE COMMA BNE DEF015 JSR PC,CNXC1 ;ELSE GET L FIELD JSR PC,GET BVS DEF016 CMP R2,#2 ;IS VARIABLE TYPE = INTEGER ? BNE DEF016 JSR PC,DEF60 ;IF ALL OK, WRITE L FIELD + COMMA MOV #DEF950,R0 ;CHECK FOR ",V," JSR PC,SCAN2A BVS DEF017 ;IF NO MATCH, GIVE A DIAGNOSTIC JSR PC,GET ;ELSE GET THE V FIELD BVS DEF018 CMP R2,#2 ;IS VARIABLE TYPE = INTEGER ? BNE DEF018 JSR PC,DEF60 ;OUTPUT THE V FIELD JSR PC,EOL CMPB (REF TO ARRAY 5$: RETURN ;HAVE OPERATOR - ONLY START OF ARRAY IS VALID 1$: CMP #STRARY,R0 BEQ 5$ CMP #STRFNC,R0 BNE 6$ TRAP+28. ;CAN'T ASSIGN TO FUNCTION BR 5$ 6$: TRAP+21. ;UNRECOGNIZED STATEMENT BR 5$ TOPT: TMVT: .BYTE 0,1,0,1,0,0,0,0,0,0,0,0 .EVEN ; ; IF LEFT HAND SIDE IS AN ARRAY OR PARAMETER THEN ; AN R0 POINTER WILL RESULT. IN THIS CASE PUSHES MAY ; BE NEEDED TO KEEP STACK OKAY ON RIGHT HAND SIDE ; RETURN C-BIT SET IF THIS IS THE CASE ; LR0CHK: MOV @POLPTR,RDD R0,R2 ;ACCUMULATE OFFSET DEC R4 ;DIMENSION COUNTER BEQ SIZT01 ;BR IF ONLY TWO DIMENSIONS MOV 4(R5),R0 ;FIRST DIMENSION MOV 6(R5),R1 ;SECOND DIMENSION JSR PC,IMULTI BCS SIZT02 MOV 10(R3),R1 ;THIRD SUBSCRIPT DEC R1 JSR PC,IMULTI BCS SIZT02 ADD R0,R2 ;TOTLA OFFSET SIZT01: MOV (SP)+,R4 ;POINTER TO SYMBOL ENTRY JSR PC,SIZSIZ ;ELEMENT SIZE TO R0 MOV R0,R5 ;A RETURN VALUE MOV R2,R1 ; JSR PC,IMULTI ;TOTAL OFFSET IN BYTES BCS SIZT04 MOV R0,R4 ;RETURN IN R4 TST 6(SP) CONSTANT AGAIN DEC DATCCT MOV DATCSV,R4 ;SAVED CONSTANT STEX ADD SYMBAS,R4 BR DATC02 ;JUMP TO FINISH UP ;HERE TO FIND A NEW (POSSIBLY REPEATED) CONSTANT DATC01: INCB NOCNSV ;INHIBIT SAVING CONST JSR PC,CNXC CMPB #'(,@R1 BEQ DATC10 ;BR=> COMPLEX! CMPB #'O,@R1 ;LOOK FOR OCTAL CONSTANT BEQ DATOCT CMPB #'",(R1) ;ALTERNATE FORM FOR OCTAL CONSTANT BEQ DATOCT CMPB #'Z,@R1 ;LOOK FOR HEX CONSTANT BEQ DATHEX CMPB #'R,@R1 ;CHECK FOR RAD50 BEQ DATR50 CMPB #'-,@R1 ;CHECK FOR R1),#') ;NEXT SHOULD BE A RT. PAREN BNE DEF019 ;IF NOT, ISSUE DIAGNOSTIC ;CHECK FOR MORE TO COME JSR PC,CNXC1 BEQ DEF11A ;THATS ALL THERE IS CMPB @R1,#', ;MUST BE COMMA SEPARATOR BNE DEF011 ;SYNTAX ERROR JSR PC,CNXC1 ;PAST COMMA BR DEF010 ;GO HANDLE NEXT ONE ;UNSUCCESSFUL EXIT TRY ASSIGNMENT STATEMENT DEF50: SEV RTS PC ; ;DEF60 WRITES NAME OF CURRENT SYMBOL, PLUS A COMMA ; DEF60: JSR PC,OUTCOM MOV CURSYM,R0 JSR PC,OUTST RTS PC DEF02: MOV CURSYM,R0 ;CHECK THAT THE A FIEL0 CMP #STRARY,R0 ;IS ARRAY BEQ 1$ ;YES CALL SERATR ;LOOK UP SYMBOL MOV CURSYM,R0 BIT #PARMKM,PARWD(R0) ;PARAMETER? BNE 1$ ;YES CLC RETURN ; 1$: SEC RETURN .SBTTL TMV: MOVE PROCESSING (SIMPLE ASSIGNMENT) ; ; TMV ; TMV: CMP STKBEG,STKRBS BNE 1$ TST LHSPOL BNE TMVYES ; FUDGE FOR WHEN EXPGEN CALLED BY I/O LIST PROCESSOR. ; ONLY OCCURS FOR SUBSCRIPTED ITEMS AND EXPECTED RESULT ; IS ADDRESS IN R0 RATHER THAN VALUE ON STACK TS;BAD SUBSCRIPT? BEQ 1$ ;NO SEC ;YES, SET BR SIZT03 ;ERROR FLAG 1$: CLC SIZT03: MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 MOV (SP),(SP)+ ;DISCARD OLD ERROR FLAG RTS PC ; SIZT02: TST (SP)+ SIZT04: CLR R4 CLR R5 SEC BR SIZT03 SIZT05: TST (SP)+ CLR R4 CLR R5 CLC BR SIZT03 ; IMULTI ; ;INTEGER MULTIPLY CONTENTS ;OF R0 BY R1 WITH ;RESULT IN R0 ;IF OVERFLOW SET C ;AND RETURN (R0) = 0 IMULTI: TST R1 BEQ IMULT4 MOV R5,-(SP) ;SAVE R5 MOV R0,R5 ;ORIGINAL VALUE IMULT1UNARY MINUS BEQ DATC04 ;BR => HAVE UNARY MINUS CMPB #'+,@R1 ;LOOK FOR UNARY + BNE DATC05 ;SKIP IT IF FOUND INC R1 DATC05: JSR PC,GET ;COLLECT A CONSTANT BVS DATC91 ;PUNT ON ERROR TST R3 BGE DATC91 ;BR=>NOT A CONSTANT: ERROR ;IS THIS A REPITION COUNT? CMPB #'*,@R1 BNE DATC03 ;BR=>NOT A REPETITION CMP #2,R2 ;INTEGER TYPE? BNE DATC92 ;BR=> WRONG TYPE FOR REPEAT MOV CURSYM,R0 MOV SYMBYT(R0),R0 ;GET THE VALUE DEC R0 BLT DATC92 ;BR=> COUNT OF ZERO OR LESS MOV R0,DATCCD CONSTANT CMP R2,#2 ;IS POSITIVE-DEFINATE BNE DEF013 ;BR IF IT IS NOT AN INTEGER TST VALUE(R0) ;ELSE IS IT POS-DEF? BLE DEF013 ;IF NEG OR 0, ERROR BR DEF012 ;ELSE GO BACK, OK ; DEF013: TRAP+122. ;BAD UNIT NUMBER BR DEF11A DEF014: TRAP+123. ;NO LEFT PAREN BR DEF11A DEF015: TRAP+124. ;ILLEGAL RECORD COUNT BR DEF11A DEF016: TRAP+125. ;ILLEGAL RECORD LENGTH BR DEF11A DEF017: TRAP+126. ;UNFORMATTED ONLY ALLOWED BR DEF11A DEF018: TRAP+127. ;ASSOCIATED VARIABLE BAD BR DEF11A DET IOL BNE 1$ CALL POP CALL CSTK 1$: INC EXTFLG RETURN ; TMVYES: MOV LHSPOL,POLPTR CALL DUMP CALL TOPCHK CALL LR0CHK BCS 3$ CALL P2R BR 2$ 3$: CALL PSC 2$: CALL POP ; FOR /OP:0 FORCE RIGHT HAND SIDE TO STACK TST OPTLVL BNE 4$ CALL CSTK 4$: MOV LTCOD,-(SP) MOV LTARG,-(SP) CALL DSPREC CALL P2R CALL TRACE CALL POP MOV LTCOD,DSCOD MOV LTARG,DSARG MOV (SP)+,RTARG MOV (SP)+,RTCOD CLR LTCOD ;NO LEFT ARG MOV #OP.V,CUROPR MOV DSCOD,R0 TSTB TMVT(R0) BNE: DEC R1 BNE IMULT2 CLC BR IMULT3 IMULT2: ADD R5,R0 BCC IMULT1 ;HAVE AN OVERFLOW ERROR CLR R0 SEC ;ERR0R - OVERFLOW IMULT3: MOV (SP)+,R5 ;RESTORE R5 RTS PC IMULT4: CLR R0 CLC RTS PC ; ; ; COPYRIGHT 1971 BY DIGITAL EQUIPMENT CORP. ; .GLOBL ZLEQLS,EQVHED,NXTCH,CNXC .GLOBL EQUIVA,LSTITM .GLOBL ADJWD,ADJMKM,OUTCHR,OUTSER .GLOBL FLABL,ALLMKM,ALLOWD ; EQUIVA ; ;EQUIVALENCE HANDLER - INPUT PHASE T ;THE REPETITION COUNT INC R1 ;SKIP OVER THE * CLRB NOCNSV ;WE NEED TO SAVE THE CONSTANT CMPB #'(,@R1 BEQ DATC10 ;BR=> COMPLEX! CMPB #'-,@R1 ;LOOK FOR UNARY MINUS BEQ DATC04 ;BR=>NEGATIVE CMPB #'O,@R1 ;LOOK FOR OCTAL BEQ DATOCT CMPB #'Z,@R1 ;LOOK FOR HEX BEQ DATHEX CMPB #'R,@R1 ;LOOK FOR RAD50 BEQ DATR50 CMPB #'+,@R1 BNE DATC07 INC R1 DATC07: JSR PC,GET DATC06: BVS DATC91 ;PUNT ON ERROR TST R3 BGE DATC91 ;NOT A CONSTANT DATC03: MOV CURSYM,DATCSV ; SUB SYMF019: TRAP+128. ;MISSING ")" BR DEF11A ;ASCII FOR ".GLOBL $DEFIL" AND "$DEFIL" DEF90: .ASCII / .GLOBL/ DEF91: .ASCII / $DEFIL/ DEF92: .BYTE 015,012 DEF93=. ;ASCII FOR THE STRING ",V," DEF95: .ASCII /,U,/ DEF96=. .EVEN DEF950: DEF95 DEF96 0 .END 1$ MOV TEXTR1,R1 TRAP+21. 1$: MOV #MOVGBL,R3 ; FOR /OP:0 DO SPECIAL HANDLING ; SO THAT $PUT(N) AND $POP(N) ARE ; GENERATED FOR USE BY TRACE P@CKAGE TST OPTLVL BEQ TMVYE0 CALL OOPGEN TMVYER: INC EXTFLG RETURN ; ; ; LEFT HAND SIDE HANDLING FOR /OP:0 CASE ; TMVYE0: CMP #COD.C,DSCOD BEQ 1$ ; ; HAVE R0 POINTER ; CNDGLN DSARG,#GL1+2,#$PUT CALL EOL BR TMVYER ; ; HAVE CORE CASE ; 1$: MOV DSARG,R2 CALL GETTYP CNDGLN R0,# ; EQUIVA: TSTB ALOKAT BGT EQUI07 JSR PC,ZLEQLS BCC EQUI01 SEV ;TRY AS ASSIGNMENT RTS PC ; EQUI01: MOV #EQVHED,R0 ;FIND WHERE TO LINK NEXT GROUP EQUI02: TST @R0 BEQ EQUI03 MOV @R0,R0 BR EQUI02 ; EQUI03: MOV R0,-(SP) ;R0 POINTS TO LINK CELL JSR PC,EQUG ;GO COLLECT A GROUP BCS EQUI04 ;SOME ERROR CLR @R0 ;R0 POINTS AT THIS GROUP MOV R0,@(SP)+ ;LINK TO PREV GROUP JSR PC,NXTCH ;"," OR EOL NEXT TSTB R2 BEQ EQUI05 ;EOL => NORMAL EXIT CMPB #',,R2 ;"," => MORE TO COMEBAS,DATCSV ;STEX TO SAVE LOC MOV CURSYM,R4 ;OUTPUT THIS CONSTANT DATC02: JSR PC,OUTCOC ;OUTPUT CONSTANT ;ALL FINISHED - GO BACK CLRB NOCNSV CLC RTS PC ; ; UNARY MINUS SCAN ; DATC04: INC R1 ;SKIP OVER MINUS JSR PC,GETN ;BUT CALL NEGATION ENTRY BR DATC06 ; ; COLLECT OCTAL OR HEX CONSTANTS ; DATOCT: JSR PC,GETOCT BR DATC06 DATHEX: JSR PC,GETHEX BR DATC06 DATR50: INC R1 ;SKIP "R" JSR PC,GETR50 BR DATC06 ; ;FUDGE UP A COMPLEX CONSTANT ; DATC10: INC R1 ;ADVANCE OVER PARGL1,#$POP MOV DSARG,R0 CALL DOAC CALL EOL BR TMVYER ; $POP: .ASCIZ / $POP/ $PUT: .ASCIZ / $PUT/ .SBTTL BOP: BINARY STACK OPERATORS (NON-OPTIMIZED) ; ; BINARY OPERATOR - OFF STACK ; BOP: CALL PSC CALL POP CALL POP CMP #COD.C,LTCOD BNE 1$ CMP #COD.C,RTCOD BNE 3$ ; HERE BOTH LEFT AND RIGHT ARE IN CORE ; PUT ON STACK IN CORRECT ORDER, IE., LEFT FIRST CALL CSTK CALL CSTKR BR 2$ ; HERE LEFT IS IN CORE, BUT RIGHT ALREADY ON S BEQ EQUI03 BR EQUI06 ;ERROR ; ;EXITS ; EQUI04: TST (SP)+ ;CLEAR STACK BR EQUI05 EQUI06: TRAP+60. ;"ILLEGAL EQV GROUP DELIMITER" EQUI05: CLC RTS PC EQUI07: TRAP+108. ;CAME AFTER DATA BR EQUI05 ; EQUG ; ;COLLECT AN EQUIVALENCE GROUP AND BUILD ;ITS DATA STRUCTURE. ;INPUT: R1 - POINTS TO TEXT ;OUTPUT: R0 - POINTS TO GROUP STRUCTURE ; R1 - POINTS PAST GROUP TEXT ; EQUG: JSR PC,NXTCH; SCAN INITIAL ( CMPB #'(,R2 ; BNE EQUG09 ;NO INITIALEN JSR PC,GCMPLX ;GET COMPLEX BVS DATC91 BR DATC03 DATC91: TRAP+105. ;"ILLEGAL OR MISSING CONSTANT" DATC90: CLR DATCCT ;CLEAR REPEAT COUNT SEC ;RETURN ERROR FLAG RTS PC DATC92: TRAP+106. ;"ILLEGAL REPEAT COUNT" BR DATC90 ; THE GLOBAL SYMBOLS FOR THIS MODULE ; (HOW THEY GOT WAY BACK HERE I DON'T KNOW!) ; .GLOBL ZLEQLS,OUTLN1,LSTITM,DATYWD,GETN,VALUE .GLOBL DATYMK,DATVCT,DATCCT,BLKDAT,DATVST,DATTYP .GLOBL DATVSV,FLABL,DATADB,DATA,ALOC .TITLE DO ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL DO,DOTMP,NXTCH,CHT1,PACK00,FLABL,GET .GLOBL CURSYM,IOL,GENLAB,OUTTAB,SERWD,OUTSER .GLOBL EOL,ASGCOM,OUTCOL,DOLST,DOEND,PARMKM .GLOBL PARWD,PARXWD,END1,PSHMKM,PSHWD .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11 ; ; DO STATEMENTS ARE STACK ; A REVERSAL MAY BE NEEDED. 3$: CALL EXCH BR 2$ ; HERE LEFT IS ON STACK, SIMPLY GET RIGHT THERE ALSO 1$: CALL CSTKR ; HERE ALL IS WELL SO DO THE OPERATION 2$: CALL BOPGEN CALL PS RETURN ; EXCH: MOV CUROPR,R2 TSTB EXCHT(R2) BNE 1$ CALL CSTK ;REVERSAL NOT NEEDED - OPR IS ASSOCIATIVE RETURN 1$: CMP #OP.LT.,R2 BGT 2$ MOVB REVOPR-10(R2),CUROPR ;USE INVERSE OPR SO CALL CSTK ;THAT REVERSAL NOT NEEDED RETURN 2$: MOV RTARG,R1 MOV LTARG,R2 MOV R2,-(SP) ;SAVE SER ( JSR PC,EQUT ;COLLECT FIRST ITEM BCS EQUG05 ;SOME ERROR REPORTED AT LOWER LEVEL CLR @R0; ZERO LINK TERMINATES ITEM CHAIN MOV R0,-(SP); SAVE ITEM START FOR LINKING JSR PC,NXTCH CMPB #',,R2 BNE EQUG06 EQUG02: JSR PC,EQUT ;SECOND & LATER ITEMS BCS EQUG10 ;"EXIT ON ITEM ERROR MOV @SP,@R0; INSERT LINK TO PREVHOUS ITEM MOV R0,@SP JSR PC,NXTCH ;NEXT CHAR TO R2 CMPB #',,R2 ;MUST BE , OR ) BEQ EQUG02 ;BR = > COMMA CMPB #'),R2 BNE EQUG06 ;BR = > NO COMMA OR ) ;HERE = > AT .GLOBL LOCADB,COMNWD,OUTCST,ALLOWD,ALLMKM .GLOBL OUTST,SIZESN,SIZESM,SIZESQ,OUTOCT,SIZT .GLOBL EOL,CURSYM,DIMMKM,DIMWD .GLOBL DATCSV,SYMBAS,NOCNSV,SYMBYT .GLOBL GET,OUTCON,GCMPLX,GETSW .GLOBL LENWD,DATYMM,ADJMKM,ADJWD,CNXC,CNXC1,CHKOCT,CHKHEX .GLOBL DATYMK,TYPSIZ,LENWD,LENMK .GLOBL SYMNXT,COMHED,OUTSER,DATLAB,OUTCHR ; OUTCOC ; ; OUTPUT CONSTANT BUT FIRST CHECK THAT ; THE TYPE MATCHES THAT OF THE VARIABLE BEING PRESET ; OUTCOC: MOV DATYWD(R4)ET UP HERE - THE DO ENTRY IS MADE ; DO: MOV #DOTMP+4,R4 DO02: MOV R4,R3 DO02B: JSR PC,NXTCH ;GET A CHARACTER JSR PC,CHT1 ;CHECK FOR NUMERIC BPL END ;NOT NUMERIC CMP R4,R3 ;SUPPRESS ZERO ? BEQ ZRTST ;YES NOZRO: MOVB R2,(R3)+ ;STORE A CHARACTER CMP R3,#DOTMP+12 ;ALL DONE? BHIS END1 ;YES BR DO02B ;RELOOP ZRTST: CMPB R2,#'0 ;IS IT A LEADING ZERO? BEQ DO02B ;YES BR NOZRO ;NO, GET ANOTHER CHARACTER END: DEC R1 ;BACK UP OVER BAD CHARACTER CLRB (R3)+ ;SET TERMINATOR END1: MOVIAL # FOR LATER CALL GETTYP MOV R0,LTARG MOV #REV,R4 CALL PUTNAM MOVB TYPLET(R0),R4 CALL PUTCHR MOVB TYPLET(R1),R4 CALL PUTCHR BITB BITM(R1),REVBIT(R0) BNE 3$ BISB BITM(R1),REVBIT(R0) CALL OUTGL CALL EOL 3$: CALL OUTNAM MOV (SP)+,R0 CALL DOAC CALL EOL RETURN EXCHT: .BYTE 0,0,0,0,0,OP.S,0,OP.D .BYTE OP.PWR,0,OP.LT.,OP.GT.,0,0,OP.LE.,OP.GE. REVOPR: .BYTE 0,0,OP.GT.,OP.LT.,0,0,OP.GE.,OP.LE. REV: .ASCIZ / $REV/ .EVEN ; ; BO) ; ;CLOSE OFF THE EQUIVALENCE GROUP ; TST (SP)+; DELETE LINK POINTER FROM STACK MOV #2,R0; GET SOME SPACE JSR PC,FRDOWN; FOR THE EQUIVALENCE GROUP HEADER BCS EQUG05; ERROR - "TABLE OVERFLOW" CLR 2(R0); GROUP FLOATING BASE 'FLT' CLR @R0; CLEAR LINK TO NEXT GROUP RTS PC; RETURN WITH C=0 ; ; ERRORS ; EQUG09: TRAP+61.; "MISSING (" BR EQUG05; EQUG06: TRAP+60.; "MISSING , OR )" EQUG10: TST (SP)+; EQUG05: SEC ; INDICATE ERROR RTS PC; ; EQUT ; ;COLLECT EQUIVALENCE ITEM AND,R2 ;TYPE WORD OF CONST TO R2 BIC #DATYMK,R2 ;CLEAR ALL BUT TYPE BITS BIC #DATYMK,DATTYP ;LIKEWISE TO VARIABLE TYPE WORD MOV DATTYP,R3 ;GET VARIABLE SWAB R3 ;TYPE BY THIS ROR R3 ;MESSY ARRANGEMENT ROR R3 ROR R3 CMP R2,#30000 ;IS CONST A HOLLERITH? BNE OUTCC7 ;BR => NOT HOLLERITH JMP OUTCC1 ;TO HANDLE HOLLERITH OUTCC7: CMP R2,DATTYP ;ELSE DO TYPES MATCH? BEQ OUTCC2 ;BR => MATCH CMP DATTYP,#10000 ;IS IT INTEGER OR LOGICAL? BHI OUTCC8 ;NO CMP R2,#10000 ;IS CONSTANT INTEGER R1,-(SP) ;SAVE R1 TEMPORARILY MOV R4,R1 ;RESET POINTER MOV #DOTMP,R0 MOV R4,-(SP) ;SAVE R4 JSR PC,PACK00 ;GET THE LINE NUMBER MOV (SP)+,R4 ;RESTORE R4 MOV (SP)+,R1 ;RESTORE R1 TST -(R0) ;IT IS A DO BNE DO02A ;IF TST -(R0) ; THE NUMBER IS NON-ZERO BEQ NOTDO ;CAN'T BE A DO IF ZERO DO02A: MOV FLABL,(R4)+ ;SAVE LABEL OF END PROCEDURE INC FLABL ;AND ADVANCE POINTER MOV R1,R0 ;TEMPORARILY REMEMBER CHARACTER POINTER DO03: JSR PC,NXTCH ;GET A CHARACTER TST R2 ;IS IT A TERMINATP - NORMAL BINARY OPERATOR ; (USES CODE FROM PREVIOUS COMPILER) ; BOPGEN: SAVREG MOV POLPTR,R5 MOV CUROPR,R0 MOV RTARG,R2 ; WE NOW HAVE A NORMAL OPERATOR IN R0, BUT ; SPECIAL THINGS MUST HAPPEN TO IT IF ; IT IS ANY OF THE RELATIONALS, NAMELY ; EQ, NE, GT, LT, GE, OR LE. ; CLR -(SP) ;CLEAR RELATIONAL SWITCH CMPB R0,LT+1 ;IS THE OPERATOR A RELATION? BLT SUB42 ;NO CMPB R0,GE+1 ;TRY AGAIN BLE RELATE ;YEA TEAM, WE GOT ONE SUB42: MOVB #TAB,R4 CALL PUTCHR TAB=11 MOVB SAVE AWAY ;INPUT: R1 - POINTS TO TEXT ;OUTPUT: R0 - WORD 0 OF ITEM ; R1 - PAST ITEM TEXT ; EQUT: MOV #LOCADB,R2; A PLACE TO PUT THE ADB JSR PC,LSTITM ;COLLECT LIST ITEM BNE EQUT09 ;SOME ERROR ;CHECK THAT ALL OKAY BIT ADJWD(R3),#ADJMKM BNE EQUT09 ;MUST NOT BE ADJUSTABLE .GLOBL PARMKM,PARWD BIT #PARMKM,PARWD(R3) ;IS IT A PARAMETER? BNE EQUT09 ;YES, BAD ERROR ;ALL OKAY SUB SYMBAS,R3; CONVERT TO SYMBOL TABLE INDEX MOV R3,LOCADB; PUT STEX IN WORKSPACE MOV #4,R3; SET LENGTH OR LOGICAL?? BLOS OUTCC2 ;YES OUTCC8: TRAP+107. ;"MISMATCHED DATA TYPES" OUTCC2: MOVB TYPSIZ(R3),R3 JSR PC,ISIL BCS INTLOG ;NORMAL CASE IS EASY JSR PC,OUTCON OUTCC5: RTS PC ;INT OR LOGICAL INTLOG: MOV #2,R3 JSR PC,OUTCON OUTCC4: CMPB #4,TYPSIZ+2 BNE OUTCC5 ;SUPPLY 0 PAD WORD MOV #OUTCC6,R4 JSR PC,OUTLN1 RTS PC ; ;IS THIS INTEGER OR LOGICAL CASE? ; YES=>SET C-BIT ; NO=>CLEAR C-BIT ; ISIL: CMP #10000,DATTYP BEQ 1$ CMP #4000,DATTYP BEQ 1$ CLC RTS PC 1$: SEC RTOR? BEQ BADSTM ;CAN'T BE A DO OR ASSIGNMENT JSR PC,CHT1 ;MUST BE ALPHANUMERIC BCC DO03 CMPB R2,#'= ;FIND BNE NOTDO ; THE = DO04: JSR PC,NXTCH ;GET A CHARACTER JSR PC,CHT1 ;IS IT ALPHANUMERIC?? BCC DO04 ;YES, SKIP IT CMPB R2,#', ;NO, IT MUST BE A COMMA BNE NOTDO ;NOT A DO STATEMENT MOV R0,R1 ;OK, IT IS A VERIFIED DO NOW. JSR PC,GET ;GET THE CONTROL VARIABLE BVS BADCV ;ILLEGAL CONTROL VARIABLE TST R3 ;IS IT A LEGAL C.V.?? BNE BADCV ;NO CMP R2,#2 ;IS C.V. INTEGER?#'$,R4 JSR PC,PUTCHR DEC R0 ;CONVERT OPERATOR INTO ASL R0 ;INDEX MOVB OPTAB(R0),R4 ;AND JSR PC,PUTCHR ;STORE MOVB OPTAB+1(R0),R4 ;THE JSR PC,PUTCHR ;OPERATOR CMP R0,#OPT ;IS THIS EXPONENTIATION BNE NOTPWR ;NO TST (SP)+ ;DISCARD LOGICAL SWITCH MOV LTARG,R3 ;GET BASE MODE MOVB CHR(R3),R4 ;GET OLD MODE JSR PC,PUTCHR ;OUTPUT IT MOVB CHR(R2),R4 ;NOW THE JSR PC,PUTCHR ;EXPONENT MODE BITB BITM(R2),EXPMAP(R3) ;DO WE NEED A GLOBAL? BNE PWR2 ;NO BISB BITM(R2),EXPMAP(R3) ;SEFOR NON-ARRAY ENTRY TST R2; IS THERE AN ADB?? BEQ EQUT01; NO ;WITH ADB MOV LOCADB+2,R3; GET # DIMENSIONS FROM ADB ROL R3; ROL R3; ROL R3; BIC #177774,R3; NUMBDR OF SUBSCRIPTS ADD #3,R3; WORDS FOR STEX, ETC. ; EQUT01: MOV R3,R0; SET NUMBER OF WORDS NEEDED JSR PC,FRDOWN; GET FREE SPACE BCS EQUT08; ERROR - "TABLE OVERFLOW" MOV R0,-(SP); SAVE START OF ITEM MOV #LOCADB-2,R2; START ADDRESS OF WORK SPACE EQUT02: MOV (R2)+,(R0)+; COPY ITEM TO COMMON/EQUIV TABLE DEC R3; COUNT NS PC OUTCC6: .BYTE TAB,'0,CR,LF,0 .EVEN ; ; HOLLERITH (UGH!) ; ; LOOK AT THE DATA SIZES AND FAKE A CONSTANT ; WHICH IS THE SMALLER OF THE TWO. (REMEMBER ; THAT 'OUTCON' WILL ROUND CONSTANT SIZE TO ; AN EVEN NUMBER OF BYTES.) ; OUTCC1: ; GUARANTEE THAT TWO ASCII BYTES ARE USED FOR INTEGER ; AND LOGICAL REGARDLESS OF ALLOCATED SIZE JSR PC,ISIL BCS OUTCD2 MOVB TYPSIZ(R3),R3 JSR PC,OUTCD1 RTS PC ; OUTCD2: MOV #2,R3 JSR PC,OUTCD1 BR OUTCC4 ;GET DATA SIZE OUTCD1: MO BNE BADCV ;NO MOV CURSYM,(R4)+ ;REMEMBER SYMBOL TABLE ENTRY CMPB (R1)+,#'= ;IS THE EQUAL NEXT?? BNE BADCV ;NO, VARIABLE NAME IS WEIRD DO08: JSR PC,GET ;GET INITIAL VALUE BVS DO09 ;BAD PARAMETER TST R3 ;IS IT A CONSTANT OR SIMPLE VAR.? BGT DO09 ;NO CMP R2,#2 ;IS I. P. INTEGER? BNE DO09 ;NO MOV CURSYM,(R4)+ ;INITIAL PARAMETER ADDRESS CMPB (R1)+,#', ;IS THE COMMA NEXT?? BNE DO09 ;NO DO05: JSR PC,GET ;GET THE END VALUE BVS DO09 ;BAD END VALUE TST R3 ;IS IT A CONSTANTT DONE FLAG JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL PWR2: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,EOL CMP R2,R3 ;WHICH MODE TO USE? BGE PWR5 ;THE HIGHER OF THE MOV R3,R2 ;TWO IS BEST PWR5: MOV R2,CURTYP MOV @R5,R2 CALL SAVCVT TST -(R5) MOV R5,POLPTR RETURN ; ; NOTPWR: TST (SP)+ ;IS THIS RELATIONAL OPERATION? BEQ PWR1A ;NO MOV #1,R2 ;SET THE MODE TO LOGICAL BR PWR1B PWR1A: CMP R0,#LOGEND-OPTAB ;IS THIS A LOGICAL OPERA BGE 1$ ;NO CMP R2,#3 ;IS THIS REAL, DOUBLEUMBER OF WORDS BGT EQUT02; CONTINUE ; MOV (SP)+,R0; RESTORE POINTER TO ITEM CLC RTS PC; RETURN WITH C=0 ; ;ERRORS: ; EQUT09: TRAP+62. ;"PARAMETER IN EQUIVALENCE STMT" EQUT08: SEC RTS PC ; ; ALLOCATION PHASE FOR COMMON& EQUIVALENCE ; .GLOBL EQVHED,EQVCLS,EQVH1,EQVH2,EQVCOM .GLOBL COMNWD,ALOKAT,ALOCAT OFFSET=2 REL=4 FLT=2 .MACRO ETRAP X MOV R1,-(SP) CLR R1 TRAP+X MOV (SP)+,R1 .ENDM .MACRO SCLBW REG,ERR,?L ; SCALE BYTE TO WORD QUANTITY CLC ROR REG; BCC L;V LENWD(R4),R2 BIC #LENMK,R2 ;SIZE IN BYTES ;TAKE MINIMUM CMP R2,R3 BLE OUTCC3 ;BR=>R2 IS SMALLER MOV R3,R2 ; R2 HAS SIZE TO USE ; FOLLOWING IS "DIRTY" CODE AND DEPENDS ON ; POSITION OF DATA SIZE IN SYMBOL TABLE OUTCC3: MOVB LENWD(R4),-(SP) ;SAVE OLD SIZE MOVB R2,LENWD(R4) ;INSERT THIS SIZE MOV R4,-(SP) ;SAVE POINTER TO ST JSR PC,OUTCON ;OUTPUT THE CONST MOV (SP)+,R4 ;THE POINTER AGAIN MOVB (SP)+,LENWD(R4) ;RESTORE PREVIOUS SIZE RTS PC OR VARIABLE?? BGT DO09 ;NO, ERROR CMP R2,#2 ;IS END VALUE INTEGER? BNE DO09 ;NO JSR PC,PVAL ;ENDING VALUE ADDRESS TSTB @R1 ;END OF STATEMENT? BEQ FIXSTP ;YES, SET STEP OF ONE CMPB (R1)+,#', ;IS THERE MORE?? BNE DO09A ;NO DO06: JSR PC,GET ;GET THE STEP BVS DO10 ;NOT GOOD TST R3 ;LEGAL STEP? BGT DO10 ;NO! CMP R2,#2 ;IS STEP INTEGER? BNE DO10 ;NO DO07: JSR PC,PVAL ;STEP VALUE ADDRESS TST IOL ;IS THIS AN IMPLIED DO?? BNE DOGEN3 ;YES, DON'T CHECK TERMINATOR TST OR COMPLEX BLT 1$ ;NO MOV TEXTR1,R1 ;TEXT POINTER TRAP+138. ;ISSUE SPECIAL CASE ERROR 1$: MOVB CHR(R2),R4 ;NOW THE JSR PC,PUTCHR ;MODE PWR1B: ASR R0 ;CONVERT TO BYTE INDEX BITB BITM(R2),GL2(R0) ;WAS A GLOBL GENERATED BNE 2$ ;YES BISB BITM(R2),GL2(R0) ;SET GENERATED BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL 2$: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,EOL MOV R2,CURTYP SUB #2,POLPTR RTS PC ;GO GENERATE MODE CHANGE IF ANY ; ; HANDLE RELATIONAL FORMS HERE RELATE: INC @ ETRAP ERR; L: .ENDM .MACRO SCLBWR REG,ERR,?L ; SCALE BYTE TO WORD AND ROUND CLC ROR REG; BCC L; INC REG; L: .ENDM .MACRO SCLWB REG,ERR,?L ; SCALE WORD TO BYTE ASL REG; BCC L; ETRAP ERR L: .ENDM ALOCAT: TSTB ALOKAT ;HAS ALLOCATION ALREADY BEEN DONE? BNE EQUE08 ;BR => YES JSR PC,ALOCOM ;DO COMMON THING TST EQVHED BEQ EQUE08 ; ;STEP 0 ;RUN THROUGH THE EQUIVALENCE LIST CONVERTING ;ALL DIMENSIONS TO ABSOLUTE OFFSETS ; EQUE00: MOV EQVHED,R0 BEQ EQUE08 ;B; OUTCON ; ; OUTPUT A CONSTANT FROM THE SYMBOL TABLE AS A ; SERIES OF WORDS IN OCTAL ; ; INPUT: R3 : SIZE OF VARIABLE TO BE FILLED ; INPUT: R4 - SYMBOL TABLE ENTRY ADDRESS OF CONSTANT ; REGISTERS CHANGED: R2,R3,R4,R5 ; .GLOBL OUTLN2,OTOA OUTCON: CMP R3,#1 ;ARE THERE MORE THAN ONE TO FILL????? BGT 1$ ;YES ; ; BYTE VARIABLE CASE ; MOV R4,-(SP) JSR R5,OUTLN2 ;PUT OUT A .BYTE OUTCO4 MOV (SP)+,R4 MOV DATYWD(R4),R3 ;IF HOLLERITH SKIPSIZE CHECK BIC #DATYMK,R3 CMPB @R1 ;TERMINATOR?? BNE DO11 ;BAD TERMINATOR BR DOGEN ;GO GENERATE THE DO CODE DO10: TRAP+49. FIXSTP: MOV R1,-(SP) ;SAVE R1 .GLOBL FDGE MOV #FDGE,R1 ;SET STEP OF ONE JSR PC,GET ;GET THE CONSTANT MOV (SP)+,R1 ;RESTORE TEXT POINTER BR DO07 ;RETURN TO MAIN HUNK OF CODE DOVF: TRAP+41. ;DO LIST OVERFLOW RTS PC NOTDO: SEV ;SET ERROR RTS PC ; AND RETURN BADSTM: TRAP+46. ;ILLEGAL DO FORMAT RTS PC BADCV: TRAP+47. ;BAD CONTROL VARIABLE BADCV1: MOVB (R1)+,R2 BEQ NODO CMPB R2SP ;SET LOGICAL SWITCH MOV #CMP,R4 ;GET THE JSR PC,PUTNAM ;COMPARE MOVB CHR(R2),R4 ;AND ITS JSR PC,PUTCHR ;MODE BITB BITM(R2),GL2+15. ;SEE IF WE NEED A GLOBAL BNE SUB44 ;NOT NEEDED BISB BITM(R2),GL2+15. ;SET GENERATED BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL SUB44: JSR PC,OUTNAM JSR PC,EOL JMP SUB42 ;NOW DO REST OF STUFF ; ; TABLES NEEDED BY BOP ; CMP: .ASCII / $CM/ .BYTE 0 ; OPTAB: .BYTE 'O,'R ;OR .BYTE 'A,'N ;AND .BYTE 'N,'T ;NOT LOGEND: .BYTE 'A,'D ;ADD .R => NO EQUIVALENCES TO DO MOV #EQUE01,R3 JSR PC,EQUL00 BR EQUE10 ; ; EQUE01: MOV @R1,R4 ;STE TO R4 ADD SYMBAS,R4 MOV R1,R3 ;PSEUDO ADB JSR PC,SIZT ;COMPUTE OFFSET BCC 1$ ;SUBSCRIPTS ARE GOOD ETRAP 97. ;SUBSCRIPTS OUT OF BOUNDS 1$: SUB R5,R4 ;ADJUST FOR ELEMENT SIZE SCLBW R4,140.; MOV R4,OFFSET(R1) ;OFFSET MOV R4,REL(R1) ;INITIAL RELATIVE LOCATION RTS PC ; ; EXIT FROM THE ALLOCATION MODULE ; EQUE08: MOVB #1,ALOKAT RTS PC #30000,R3 BEQ 5$ MOV SYMBYT(R4),R3 ;GET VALUE BIC #177,R3 ;HIGH 9 BITS SHOULD ALL BEQ 5$ ;BE ZERO OR COM R3 BIC #177,R3 ;ALL BE ONES BEQ 5$ TRAP+142. ;BYTE OVERFLOW 5$: MOVB SYMBYT(R4),R3 BIC #177400,R3 ;USE EIGHT BITS IN ANY EVENT CLR -(SP) ;MAKE CLR -(SP) ;SOME CLR -(SP) ;WORKING CLR -(SP) ;ROOM MOV SP,R2 ;CONVERT BYTE TO ASCII JSR PC,OTOA ;NOW SUB #3,R2 ;POINT TO START OF STRING MOV R2,R4 ;GET PROPER POINTER 4$: JSR PC,OUTLN1 ;PUT OUT THE STRING CMP (S,#'= BNE BADCV1 BR DO08 DO09A: DEC R1 ;BACK UP CHARACTER POINTER TST IOL ;IS THIS AN IMPLIED DO?? BNE FIXSTP ;YES, DON'T CHECK TERMINATOR DO09: TRAP+48. CCC RTS PC ; DO11: TRAP+12. DOGEN: JSR PC,GENLAB ;GENERATE A LABEL DOGEN3: MOV #DOTMP,R5 JSR PC,OUTTAB ;OUTPUT A TAB MOV 10(R5),R2 ;GET ADDRESS OF INITIAL VALUE MOV SERWD(R2),R3 ;GET SERIAL NUMBER BIC #170000,R3 ;CLEAR JUNK BITS BIS #PSHMKM,PSHWD(R2) ;SET PUSH FLAG MOV #'P,R0 ;AND JSR PC,OUTSER ;OUTPUT THE JSR PC,EOL BYTE 'S,'B ;SUBTRACT .BYTE 'M,'L ;MULTIPLY .BYTE 'D,'V ;DIVIDE OPT1: .BYTE 'P,'W ;EXPONENTIATE OPT=OPT1-OPTAB .BYTE 'N,'G ;NEGATE .BYTE 'L,'T ; .LT. .BYTE 'G,'T ; .GT. .BYTE 'E,'Q ; .EQ. .BYTE 'N,'E ; .NE. .BYTE 'L,'E ; .LE. .BYTE 'G,'E ; .GE. .EVEN .SBTTL UOP: UNARY OPERATORS ; ; UOP - UNARY OPERATORS ; UOP: CALL PSC CALL POP CALL CSTK MOV CURTYP,RTARG ;A FUDGE BECAUSE OF BOPGEN CALL BOPGEN CALL PS RETURN ; ; PUSH ;STEP 1 ;COLLECT AN EQUIVALENCE CLASS BY TAKING FIRST GROUP ;& CONNECT TO EQVCLS. THREAD THROUGH EQVCLS OF ATTACH ;NEW ITEMS TO EQVCLS. ; ;SET UP R & F ARRAY VALUES AS WE GO ; EQUE10: MOV #EQVHED,R0 ;LINK FIRST EQU GROUP TO EQUALS TST @R0 ;IS THERE MORE? BEQ EQUE08 ;BR => NO - GO EXIT CLR EQVCLS JSR PC,EQUZ00 ;THE LIST MOVER MOV @R4,R0 ;GET POINTER TO THIS GROUP CLR FLT(R0) ;FLOATING BASE THIS GROUP CLR EQVH1 ;MAXIMUM LOW EXTENSION CLR EQVH2 ;MAXIMUM HIGH EXTENSION MOV #EQP)+,(SP)+ ;DISCARD CMP (SP)+,(SP)+ ;TEMPORARY BR OUTCO5 ; ; NON-BYTE VARIABLE CASES ; 1$: MOV R4,-(SP) MOV R3,-(SP) JSR R5,OUTLN2 OUTCO1 MOV (SP)+,R3 MOV (SP)+,R4 MOV @R4,R5 ;GET CONSTANT SIZE BIC #177400,R5 INC R5 ;CONVERT BYTE COUNT TO CLC ;WORD COUNT BY ROUNDING UP ROR R5 ADD #SYMBYT,R4 ;BEGINNING OF CONST MOV R3,R2 ;MOVE ELEMENT SIZE TO SAFE PLACE ASR R2 ;MAKE INTO WORDS OUTCO2: MOV (R4)+,R3 JSR PC,OUTOCT DEC R2 DEC R5 BGT OUTCO3 TST R2 ;IS ELEMENT ;PUSH AND AN END-OF-LINE MOV #6,R4 JSR PC,FIXP ;SET UP CONTROL VARIABLE JUNK MOV R5,-(SP) ;SAVE R5 MOV #2,R2 ;SET INTEGER MODE JSR PC,ASGCOM ;DO THE PROPER POP MOV (SP)+,R5 ;RESTORE R5 MOV 4(R5),R3 ;GET THE LABEL SERIAL NUMBER MOV #'F,R0 ;AND GENERATE JSR PC,OUTSER ;A LABEL JSR PC,OUTCOL ; FOLLOWED BY A COLON JSR PC,EOL MOV #DOLST,R4 ;GET ADDRESS OF DO LIST DO01: CMP R4,#DOEND ;OVERFLOW? BHIS DOVF ;YES TST @R4 ;NO, EMPTY ENTRY BEQ DOPUT ;YES , FOUND IT ADD #16,R4 ;C OR P ITEMS ON INTERNAL STACK ; AND ADVANCE POLPTR ; PSHOPC: CALL PCX PSHOP1: SUB #2,POLPTR RETURN ; PSHOPP: CALL PP BR PSHOP1 .SBTTL MODCVT: MODE CONVERSIONS ; ; MODE CONVERSION ; MODCVT: SAVREG CALL PSC CALL POP CALL CSTK TSTB ERRFLG BEQ 2$ TRAP+7. ;MIXED MODE 2$: MOV #TABDOL,R4 CALL PUTNAM MOV CURTYP,R2 MOV WORKI,R3 MOVB CHR(R2),R4 ;STORE JSR PC,PUTCHR ;THE MOVB CHR(R3),R4 ;MODE JSR PC,PUTCHR ;CONVERSION BITB BITUE20,R3 JSR PC,EQUL00 BR EQUE50 ; FOR EACH ITEM EQUE20 GETS CALLED ; EQUE20: MOV REL(R1),R2 ;FIRST COMPUTE LOWEST EXTENT OF SUB FLT(R0),R2 ;STORAGE FOR THIS ELEMENT CMP R2,EQVH2 ;IS IT THE MAX YET? BLE EQUE21 ;BR = > NO MOV R2,EQVH2 ;YES EQUE21: MOV @R1,R4 ;WILL COMPUTE SIZE JSR PC,SIZESN ;VALUE IN R4 (IGNORE R5) SCLBWR R4,140.; SUB REL(R1),R4 ADD FLT(R0),R4 ;COMPUTE THE HIGHEST EXTENT CMP R4,EQVH1 ;HIGHEST YET? BLE EQUE30 ;BR = > FILLED YET? BLE OUTCO5 ;BR=>YES - DONE MOV #BLANKS,R4 ;ONLY FOR HOLLERITH! OUTCO3: MOV R4,-(SP) ;SAVE STE POINTER MOV #',,R4 JSR PC,OUTCHR MOV (SP)+,R4 ;RESTORE STE POINTER BR OUTCO2 ; OUTCO5: JSR PC,EOL RTS PC ; ; BLANKS: .ASCII / / ;TWO BLANKS OUTCO1: .ASCIZ '.WORD' OUTCO4: .ASCIZ '.BYTE' OUTCO6: .ASCIZ '377' .EVEN ; ; GETOCT ; ; COLLECT AN OCTAL CONSTANT AND FORM A ; (FAKE) SYMBOL TABLE ENTRY ; GETOCT: CLR -(SP) ;FLAG CELL FOR ERRORS CLR R0 ;SKIP OVER ELEMENT BR DO01 ;RE-LOOP TO FIND EMPTY SPACE DOPUT: MOV (R5)+,(R4)+ ;NOW MOV (R5)+,(R4)+ ;PLACE MOV (R5)+,(R4)+ ;THE MOV (R5)+,(R4)+ ;TEMPORARY ENTRY MOV (R5)+,(R4)+ ;IN PERMANENT MOV (R5)+,(R4)+ ;TABLE MOV (R5)+,(R4)+ NODO: RTS PC DOCODE: .ASCII / $POP2/ .BYTE 0 .EVEN FIXP: ADD R5,R4 ;COMPUTE ADDRESS OF ITEM MOV @R4,R3 ;GET THE SYMBOL MOV R3,CURSYM ;TABLE ADDRESS BR PVAL00 ;GO GET THE PARAMETER PVAL: MOV CURSYM,R3 PVAL00: BIT #PARMKM,PARWD(R3) ;IS IT A PARAMETERM(R2),CV1(R3) ;GENERATE GLOBAL? BNE 3$ ;NO BISB BITM(R2),CV1(R3) ;YES, SET GENERATED JSR PC,OUTGL JSR PC,EOL 3$: JSR PC,OUTNAM JSR PC,EOL ;DO AN END-OF-LINE MOV R3,CURTYP CALL PS RETURN CHR: .BYTE 'B,'I,'I,'R,'D,'C,'J,'X TABDOL: .ASCIZ / $/ .EVEN .SBTTL ARRAY PROCESSING ; ; ARRAY PROCESSING ; ARRAY: SUB #2,POLPTR CALL PSC CALL DSPREC CALL PR RETURN ; ; ON FINDING A COMMA ; COMMA: MOV POLPTR,R5 MOV -(R5),R0 BIC #377,R0 NO MOV R4,EQVH1 ;YES EQUE30: MOV FLT(R0),R5 ;FLOATING BASE THIS GROUP MOV EQVHED,-(SP) ;START AT HEAD OF LIST EQUE33: MOV @SP,R0 MOV @R0,@SP TST R0 BEQ EQUE32 ;BR => END OF LIST MOV R0,R2 ;R2 WILL POINT TO GROUPS ADD #4,R2 ;FIRST ITEM THIS GROUP BR EQUE34 EQUE35: TST -(R2) ;BACK UP TO LINK POINTER MOV @R2,R2 ;GET NEXT ITEM BEQ EQUE33 ;END OF THIS GROUP, ANOTHER? EQUE34: TST (R2)+ ;POINT AT STEX OF ITEM CMP @R1,@R2 ;DO THE PAIRS MATCH? BNE EQUE35 ;BR => NO - LOOK FURTHEDEVELOP RESULT HERE GETOC1: JSR PC,CNXC1 ;NEXT CHAR BEQ GETOC8 ;BR=>END OF LINE JSR PC,CHKOCT ;VALID OCTAL DIGIT BVS GETOC8 ;BR=>END OF CONSTANT CLC ;CLEAR C-BIT FOR ROTATING ROL R0 BCS GETOC9 ;BR=>OVERFLOW ROL R0 BCS GETOC9 ROL R0 BCS GETOC9 ADD R5,R0 ;ADD IN CHAR VALUE BR GETOC1 ;LOOK FOR MORE GETOC9: INC @SP ;FLAG AS ERROR BR GETOC1 ;SCAN OFF REST OF CONSTANT ; ; GETHEX ; GETHEX: CLR -(SP) CLR R0 GETHE1: JSR PC,CNXC1 ;NEXT CHAR BEQ GETHE8 JSR PC,CHKHEX? BEQ PVAL01 ;NO MOVB PARXWD(R3),R3 ;GET THE INDEX BIC #177400,R3 ;CLEAR EXTRANEOUS BITS PVAL01: MOV R3,(R4)+ ;STORE THE PARAMETER RTS PC .END CMP #101000,R0 ;SUBSCRIPT OPERATOR? BEQ 1$ MOV R5,POLPTR ; FORCE ARG TO STACK NOW SO IN CORRECT ; ORDER FOR LATER SUBSC OPERATION CALL POP CALL CSTK RETURN ; ; TIME TO GENERATE SUBSCRIPT OPERATION ; 1$: TSTB ARYCHK ;ARRAY CHECKING ON? BNE OLDWAY TSTB OPTLVL BEQ OLDWAY MOV @R5,R0 ;GET ARRAY CODE BIC #177770,R0 ;ISOLATE # DIMENSIONS DEC R0 ;IF 1 THEN DO OPT STUFF BEQ ARYOPT OLDWAY: JMP ARYREF ; ; PASSED ALL THE TESTS, SO DO FASTER SUBSCRIPTS ; ARYOPT: CALL POP MR MOV R0,-(SP) ;SAVE POINTER THIS GROUP JSR PC,EQUZ10 ;MOVE THIS GROUP MOV (SP)+,R0 MOV @R4,R4 ;NEW LINK ADD #FLT,R4 ;POINTER TO FLOAT MOV R5,@R4 ADD REL(R2),@R4 SUB REL(R1),@R4 BR EQUE33 ;KEEP LOOKING EQUE32: TST (SP)+ ;CLEAR STACK RTS PC ;ALL DONE ;STEP 5 ; ; WE NOW HAVE THE ENTIRE EQUIVALENCE CLASS ; ON THE LIST EQVCLS. NEXT ;RUN THROUGH LOOKING AT ALL PAIRS OF VARIABLES ;IF SAME VARIABLES THEN CHECK FOR CONSISTENCY ; EQUE50: MOV #EQUE53,R3 MOV EQVCLS,R0 JSR BVS GETHE8 CLC ROL R0 BCS GETHE9 ROL R0 BCS GETHE9 ROL R0 BCS GETHE9 ROL R0 BCS GETHE9 ADD R5,R0 BR GETHE1 GETHE9: INC @SP BR GETHE1 ; GETOC8: GETHE8: TST (SP)+ ;LOOK AT ERROR FLAG BEQ GETOH1 ;CLEAT SAYS OKAY TO CONTINUE SEV RTS PC ; GETOH1: MOV #FAKSYM,R5 MOV R0,VALUE(R5) ;VALUE INTO SYMBOL ATBLE ENTRY MOV #10402,@R5 ;INT CONST LENGTH=2 MOV R5,CURSYM MOV #177777,R3 CLV RTS PC ; ; MAKE FAKE SYMBOL TABLE ENTRY FOR RAD50 ; RAD50 CAN ONLY BE USED WITH OV #OP.X,CUROPR ;SUBSC OPERATOR CLR RTCOD ;DON'T USE "RIGHT" ARG SLOT MOV -(R5),R2 ;GET ARRY SERIAL CALL GETTYP ;GET ITS TYPE MOV R0,-(SP) ;TUCK IT AWAY FOR NOW MOV CURSYM,R2 ;ST POINTER BIT #PARMKM,PARWD(R2) ;PARAMETER? BEQ ARYCOR ;BR IF NOT ; ARRAY IS PARAMETER MOV #COD.A,DSCOD ;SET UP CODE FOR ADB REFERENCE MOV @R5,DSARG CALL ARYOFF ;IS SUBSCRIPT A CONSTANT? BCS ARYP ;BRANCH IF YES ARYC1: MOVB TYPSIZ(R0),R1 ;BYTES PER ELEMENT ARYC3: ADD #TYP.0,R1 ;MAKE INTO TYPE CODE MOV PC,EQUL00 BR EQUE60 ; ; THIS GETS FIRST OF PAIRS INTO R2 AND ; SETS UP CALL FOR SECOND ITEM OF PAIR ; LEAVE R0 ASIS TO BEGIN ; WITH THIS GROUP EQUE53: MOV FLT(R0),R4 SUB OFFSET(R1),R4 MOV R1,R2 MOV #EQUE56,R3 JSR PC,EQUL00 RTS PC ; ; R1 AND R2 POINT AT ITEMS TO BE COMPARED ; EQUE56: CMP @R1,@R2 BNE EQUE57 ;BR => NOT THE SAME VARIABLES MOV FLT(R0),R0 SUB OFFSET(R1),R0 CMP R0,R4 BNE EQUE58 ;BR => ERROR: NOT THE SAME EQUE57: RTS PC ; ; ; EQUE58: ETRAP 63REAL VARIABLES ; GETR50: MOV #FAKSYM,R0 MOV R0,CURSYM ;POINTER TO FAKE ENTRY MOV #14404,@R0 ;REAL CONSTANT LENGTH = 4 ADD #VALUE,R0 ;POINT TO VALUE PART JSR PC,PACK00 ;RAD50 PACK MOV #-1,R3 ;CONSTANT FLAG RTS PC TAB=11 CR=15 LF=12 .END .TITLE DOFIN ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL DODON,DOTMP,PACK00,DOLST,DOEND,PUTNAM,PUTCHR .GLOBL BITM,MISC,OUTGL,EOL,OUTNAM,OUTCOM .GLOBL OUTSER,OUTST,OUTOCT,LINENO,IOL .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11 ; ; DODON - STATEMENT LINE NUMBER IS CHECKED FOR ; A REQUIRED R1,CURTYP ;PSEUDO-TYPE ARYC2: MOV #ARYGBL,R3 ;BIT MAP TABLES CALL OOPGEN ;GENERATE MOV (SP)+,CURTYP ;UPDATE THE REAL TYPE MOV @R5,R2 ;SERIAL OF ARRAY CALL SAVCVT ;SAVE MODE CONVERSION TST -(R5) ;UPDATE POLPTR MOV R5,POLPTR INC EXTFLG RETURN ; ; ARRAY IS PARAMETER WITH CONSTANT SUBSCRIPT ; ARYP: MOV R0,LTARG ;SAVE BYTE OFFSET MOV #COD.K,LTCOD MOV #TYP.0,CURTYP BR ARYC2 ;DO THE REST ; ; ARRAY IS LOCALLY ADDRESSABLE ; ARYCOR: CALL ARYOFF ;CONSTANT SUBSCRIPT? BCS 1$ . ;"INCONSISTANT EQUIVALENCE" JSR R5,OUTCH2 '; MOV @R1,R0 JSR PC,OUTSTR ;NAME OF VARIABLE JSR PC,EOL RTS PC ;STEP 6 ; ;LOOK TO SEE IF ANY ITEM FROM THIS CLASS IS IN COMMON. ;IF SO THEN AT MOST ONE CAN BE IN ;COMMON ; EQUE60: CLR EQVCOM ;ZERO => NONE IN COMMON MOV EQVCLS,R0 ;NOT ZERO => VARIABLE S.T. ADDRESS MOV #EQUE63,R3 JSR PC,EQUL00 BR EQUE68 ; ; ; EQUE63: MOV @R1,R2 ADD SYMBAS,R2 BIT COMWD(R2),#COMMKM BNE EQUE65 ;BR => YES DO ENDING. IF REQUIRED, THE ENDING ; IS GENERATED AND THE DO ENTRY IS CLEARED. ; NODO: MOV (SP)+,R3 BNE DOEND5 NOTDO: RTS PC DODON: MOV #LINENO,R1 ;GET THE CURRENT LINE NUMBER MOV #DOTMP,R0 JSR PC,PACK00 ;CONVERTED TO BINARY TST -(R0) BNE DODON1 TST -(R0) BEQ NOTDO ;EXIT IF NO MATCH DODON1: MOV #DOLST,R4 ;ADDRESS OF PERM. LIST MOV #DOTMP,R0 ;ADDRESS OF CURRENT LINE NUMBER CLR -(SP) ;SET FALSE TERMINATOR DOEND1: CMP R4,#DOEND ;ARE WE AT END OF LIST? BHIS NODO ;YES, NOTHING T ;BR IF YES MOV #COD.B,DSCOD ;WILL USE ARRAY MOV @R5,DSARG MOV @SP,R2 ;BASE LESS ELEMENT MOVB TYPSIZ(R2),R2 ;SIZE IN BYTES NEG R2 MOV R2,RTARG MOV @SP,R0 ;GET ARRAY TYPE BACK BR ARYC1 ; ; ARRAY IN CORE WITH CONSTANT OFFSET ; 1$: MOV #COD.B,DSCOD ;ANN UNUSUAL CODE MOV R0,RTARG ;SAVE OFFSET MOV @R5,DSARG ;ARRAY SERIAL CLR R1 ;USE TYP.0 MOV #COD.C,LTCOD ;ONLY ONE ARG, IE DSARG CLR LTARG ;THIS SUSPRESSES C ARG GEN BR ARYC3 ; ; COMPUTE ARRAY OFFSET IF SUBSCRIPT IS A C, IN COMMON EQUE64: RTS PC ;IF NOT - JUST QUIT. EQUE65: TST EQVCOM ;ANY IN COMMON BEFORE? BEQ EQUE67 ;BR => NO - WHICH IS FINE SUB SYMBAS,R2 CMP R2,EQVCOM BEQ EQUE64 ;BR=>IS SAME VARIABLE ETRAP 64. ;"MULTIPLE EQUIVALENCE ITEMS IN COMMON JSR R5,OUTCH2 '; MOV R2,R0 JSR PC,OUTSTR JSR R5,OUTCH2 ', MOV EQVCOM,R0 JSR PC,OUTSTR JSR PC,EOL RTS PC ; ; ; EQUE67: SUB SYMBAS,R2 ;REMEMBER DISPLACEMENT MOV R2,EQVCOM ;"REMEMBER COMMON ITEM" MOV FLT(R0),R4 SUB OFFSET(R1),R4 .TITLE ELOC ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; .GLOBL LOWLOC,BEG .CSECT LOWLOC = . BEG = . .END HERE TST @R4 ;IS THIS ENTRY EMPTY? BEQ NODO ;YES MOV R4,R3 ADD #16,R4 ;POINT TO NEXT ENTRY CMP (R3)+,@R0 ;DOES FIRST WORD MATCH? BNE DOEND1 ;NO CMP (R3)+,2(R0) ;DOES SECOND WORD MATCH? BNE DOEND1 ;NO CLR @SP ;CLEAR ERROR CMP R4,#DOEND ;LAST ENTRY? BHIS DOEND2 ;YES, CAN'T BE BAD NEST TST @R4 ;IS THIS THE LAST ENTRY? BEQ DOEND2 ;YES MOV R3,@SP ;REMEMBER ENTRY BR DOEND1 ;AND RE-LOOP DOEND2: MOV (SP)+,R4 ;IS THE CHAIN OK? BEQ DOEND4 ;YES MOV R4,R3 ;NO DOEND5: TSTONSTANT ; ARYOFF: SAVREG MOV R0,-(SP) ;SAVE ARRAY TYPE MOV LTCOD,R2 CMP #COD.C,R2 ;MUST BE IN CORE BNE 1$ ;ISN'T MOV LTARG,R2 CALL GETTYP ;LOOK UP SUBSCRIPT MOV CURSYM,R2 BIT #CONMKM,CONWD(R2) ;IS CONSTANT? BEQ 1$ MOV (SP)+,R0 ;RECOVER ARRAY TYPE MOVB TYPSIZ(R0),R3 ;ELEMENT SIZE MOV VALUE(R2),R2 ;GET VALUE BGT 2$ MOV TEXTR1,R1 ;SOURCE TEXT POINTER TRAP+146. ;NEGATIVE SUBSCRIPT 2$: CLR R0 ;RESULT REG 4$: DEC R2 BEQ 3$ ADD R3,R0 BR 4$ 3$: SEC ;IS CONSTANT FLAG MOV R4,EQVDEL RTS PC ;HERE ALL IS WELL AND WE CAN PROCEED CONFIDENTLY ; EQUE68: MOV EQVCOM,R4 ;ARE WE DEALING WITH COMMON OR NOT? BEQ 1$; BR => NOT IN COMMON ADD SYMBAS,R4 MOVB COMNWD(R4),R4 MOV EQVCLS,R0 ;WE MUST MARK EVERY ITEM IN MOV #EQUE69,R3 ;THIS CLASS AS BEING IN COMMON JSR PC,EQUL00 ;THE USUAL LOOP BR EQUE70 1$: JMP EQUE80; ; ; ; EQUE69: MOV @R1,R2 ADD SYMBAS,R2 BIS #COMMKM,COMWD(R2) ;SET THE COMMON BIT MOVB R4,COMNWD(R2) ; IOL ;ARE WE IN IMPLIED LIST? BNE DOEND4 ;YES, CAN'T HAVE NESTING ERROR TRAP+40. ;ISSUE ERROR DOEND4: MOV #DOPRO,R4 ;YES, WONDERFUL JSR PC,PUTNAM ;GET THE PROTOTYPE MOV #400,R4 ;SEE IF CMP 2(R3),R4 ;ANY BLO FND01 ;OF CMP 4(R3),R4 BLO FND01 CMP 6(R3),R4 ;VALUES BLO FND01 ;ARE CMP 10(R3),R4 ;FORMAL BLO FND01 ;SUBROUTINE PARAMETERS MOVB #'O,R4 ;THEY ARE NOT, SO GENERATE SIMPLE JSR PC,PUTCHR ; FORM MOV #3,R4 BR FND02 FND01: MOVB #'P,R4 ;GENERATE THE LONG FORM JSR P RETURN ; 1$: MOV (SP)+,R0 ;RECOVER ARRAY TYPE CLC ;NOT A CONSTANT RETURN .SBTTL ARRAY PROCESSING - NONOPTIMIZED ; ; ARRAY REFERENCES ARE GENERATED HERE ; ARYREF: CALL POP ;GET LAST SUBSCRIPT ON STACK CALL CSTK MOV #ARYR01,R4 ;GET PROTOTYPE ADDRESS TSTB ARYCHK ;DO WE DO SUBSCRIPT CHECKING? BEQ ARYR07 ;NO MOV #ARYR08,R4 ;YES, DO SBX INSTEAD OF SBS ARYR07: MOV @R5,R2 ;GET SUBSCRIPT COUNT BIC #177770,R2 CNDGLN R2,#GL1+1,R4 ;GLOBL, ETC BLOCK # RTS PC ;ALLOCATE THE EQUIVALENCED ITEMS INTO COMMON BLOCK ; ; EQUE70: BIC #177400,R4 ;MASK TO UNSIGNED COUNT MOV #COMHED,R0 ;LOCATE N-TH COMMON BLOCK EQUE71: MOV @R0,R0 DEC R4 BNE EQUE71 ;R0=DESIRED COMMON BLOCK JSR PC,OUTCST ;ESTABLISH CSECT MOV EQVCOM,R1 ;FOR ALOXXX TO COMPUTE JSR PC,ALOXXX ;OFFSET FROM COMMON BASE SCLBW R0,140.; MOV R0,EQVH3 ;SAVE FOR LATER USE MOV #EQUE72,R3 ;THE ROUTINE TO CALL MOV EQVCLS,R0 ;NEXT LOOP PUTTIN .TITLE ENDPRO .IDENT /0609/ ;RBG, 20-APR-73 ; ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; .GLOBL OUTCHR,CURSYM,OUTSER,OUTCOL,OUTTAB .GLOBL OUTST,EOL,SYMBAS,OUTOCT,TYPSIZ .GLOBL OUTLN1,BLKDAT,RETURN,GENLAB,SERIAL .GLOBL NAMSER,SERATR,OUTSER,PARMKM,PARWD .GLOBL VALUE,OUTCHR,DLAB,RLAB,FLABL,DPC,RPC .GLOBL EXIT,PARXWD,OUTLN2,OUTCH2,ENDPRO .GLOBL PSHWD,PSHC,PUTCHR ;IF ANY PARAMETERS EXIST MOV #4,R4 FND02: BITB BITM(R4),MISC+1 ;DID GLOBAL ALREADY GET DONE? BNE FOUND1 ;YES BISB BITM(R4),MISC+1 ;NO JSR PC,OUTGL JSR PC,EOL FOUND1: JSR PC,OUTNAM JSR PC,OUTCOM MOV 10(R3),R0 ;GET ADDRESS OF STEP JSR PC,VAL001 ;OUTPUT THE NAME JSR PC,OUTCOM ;FOLLOWED BY A COMMA MOV 2(R3),R0 ;GET CONTROL JSR PC,VAL001 ; VARIABLE JSR PC,OUTCOM ; FOLLOWED BY A COMMA MOV 6(R3),R0 ;GET TERMINAL JSR PC,VAL001 ; VARIABLE JSR PC,OUTCOM ; FOLLOWED BY A COMM MOV -(R5),R0 ;GET THE SERIAL NUMBER MOV R0,R2 ;SAVE CONVERSION SPEC CALL SAVCVT MOV R0,R2 ;GET THE ACTUAL TYPE CALL GETTYP MOV R0,CURTYP ;AND MAKE IT CURRENT MOV @R5,R0 ;GET SERIAL AGAIN CALL DOAA CALL EOL TST -(R5) MOV R5,POLPTR INC EXTFLG RTS PC ARYR01: .ASCIZ / $SBS/ ;SUBSCRIPT ROUTINE ARYR08: .ASCIZ / $SBX/ ;SUBSCRIPT ROUTINE, CHACK BOUNDS .EVEN .SBTTL FUNCTION PROCESSING - START AND SVSP ; ; FUNCTION PROCESSING STARTS HEG OUT THE JSR PC,EQUL00 ;ITEMS IN THIS CLASS. ;ESTABLISH UPPER LIMIT OF THESE VARIABLES JSR R5,OUTLN2 EQUE74 MOV EQVCOM,R0 JSR PC,OUTSTR ;NAME JSR R5,OUTCH2 '+ MOV EQVH1,R3 SUB EQVDEL,R3 SCLWB R3,139.; JSR PC,OUTOCT ; THIS MAY EXTEND THE UPPER END OF JSR PC,EOL ;THIS CSECT. (THIS IS OKAY!) MOV #ALOC81,R4 MOV #7,R5 JSR PC,OUTLN JSR PC,EOL JMP EQUE10 ;BACK FOR NEXT CLASS. ; ;A SYMBOL RELATIVE TO A SYMBOL IN COMMON ; EQUE72: MOV @R1,R4 ;GET STEX CMP R4,EQVCOM ;BASMKM,ADBFLG .CSECT ; ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; TAB = 11 ; ; END PROCESSING - CLEAN UP THE WHOLE #!*X MESS. ; ; ; MULTIPLY INTEGER IN R4 BY INTEGER IN R3 ; RESULT IS RETURNED IN R2 AND R4, R3 IS LEFT ; UNCHANGED. ; ; REGISTERS CHANGED - R2,R4. ; IMUL: MOV R1,-(SP) ;SAVE TEMPORARY CLR R1 ;CLEAR TEMPORARY CLR R2 ;CLEAR HIGH ORDER DESTINATION MOV #21,-(SP) ;SET COUNT OF 17 IMUL01: ROR R1 ;KEEP TRACK ROR R2 ;OF WHAT BIT ROR R4 ; GETS MULTIPLIED A MOV R3,R5 ;SAVE POINTER MOV @R5,R3 ;GET LABEL ADDRESS MOV #'F,R0 ; AND KEY JSR PC,OUTSER ;OUTPUT THE LABEL JSR PC,EOL ; AND AN END-OF-LINE CLR -2(R5) ;CLEAR CLR -4(R5) CLR (R5)+ ;THE CLR (R5)+ ;SEVEN CLR (R5)+ ;ENTRIES CLR (R5)+ ;IN THE CLR (R5)+ ;DO TABLE BR DODON ;AND LOOK FOR MORE DOPRO: .ASCII / $ENDD/ .BYTE 0 .EVEN VAL001: MOV R3,-(SP) ;SAVE R3 CMP R0,#400 ;IS THIS A FORMAL PARAMETER? BLO VAL002 ;YES JSR PC,OUTST ;NO, OUTPUT THE SYMBOL NAME BR VALRE ; FUNC: SUB #2,POLPTR CALL PSC CALL DSPREC CALL PG RETURN ; ; SVSP ; SVSP: MOV POLPTR,R5 CALL POP MOV LTCOD,R1 ASL R1 JMP @SVSPD(R1) SVSPD: ERR203 ;NULL ERR203 ;CORE GNSVSP ;ON STACK GNSVE ;ADR IN R0 GNSVSP ;IN F0, ALSO ON STACK GNSVG ;IN R0-R3 GNSVPA ;PARAMETER ; ; GNSVG: MOV LTARG,R2 CALL GEN$PR BR GNSVSP ; ; GNSVPA: CNDGLB CALL OUTCOM MOV LTARG,R0 CALL SERATR MOV CURSYM,R3 MOVB @R3,R3 CALL OUTOCT BR SVSP04E SYMBOL? BEQ EQUE75 ;BR => SKIP BASE SYMBOL ADD SYMBAS,R4 ;CHECK FOR ALREADY ALLOCATED BIT #ALLMKM,ALLOWD(R4) BNE EQUE75 BIS #ALLMKM,ALLOWD(R4) ;MARK ALLOCATED SUB SYMBAS,R4 JSR PC,OUTSTS ;PUT IT OUT JSR R5,OUTLN2 EQUE73 MOV EQVCOM,R4 ;RELATIVE TO THE ORIGINAL COMMON ITEM JSR PC,OUTSTS JSR R5,OUTCH2 '+ MOV FLT(R0),R3 SUB REL(R1),R3 SUB EQVDEL,R3 MOV R3,-(SP) ;SAVE FOR LATER MAGNITUDE CHECK ASL R3; SCALE WD TO BYTE-NO CHECK JSR PC,OUTOCT ;THE DISPLACEMENT JSR PC,E BCC IMUL02 ;DON'T DO ANYTHING IF BIT CLEAR ADD R3,R2 ;ADD IN THE ADC R1 ;PARTIAL PRODUCT IMUL02: DEC @SP ;HAVE WE DONE IT ENOUGH? BNE IMUL01 ;NO TST (SP)+ ;POP THE COUNTER MOV (SP)+,R1 ;RESTORE R1 RTS PC ;AND RETURN TO CALLER .GLOBL ADBPWD CKAR01: JSR R5,OUTCH2 '0 BR CKAR02 CKARY: MOV R0,-(SP) MOV R2,-(SP) ;SAVE MODE MOV #5,R4 ;GENERATE PUSH ROUTINE JSR PC,TSTPSH ; IN CASE OF OVERFLOW MOV CURSYM,R5 ;GET POINTER TO ELEMENT CL003 ;GO STORE IT VAL002: MOV R0,R3 JSR PC,OUTOCT ;GET THE PARAMTER NUMBER VAL003: MOV (SP)+,R3 RTS PC .END ; ; GNSVE: CNDGLB BR SVSP02 GNSVSP: MOV @R5,R0 MOV R0,R4 BIC #177407,R4 ;GET THE ASR R4 ;DEPTH OF CALL ASR R4 CMP R4,#50 ;IS IT TOO DEEP?? BGE SVSP05 ;YES BIC #177770,R0 ;GET THE MODE MOVB TLGTH(R0),R0 ;GET THE LENGTH ADD R0,FNSTK(R4) ;PLACE LENGTH AWAY SVSP03: CNDGLB SVSP02: SVSP04: JSR PC,OUTCOM ;OUTPUT A COMMA MOV -(R5),R3 ;GET THE LABEL MOV #'F,R0 CALL OUTSER CALL EOL TST -(R5) MOV R5,POLPTR RETURN SVSP05: MOV TEXTROL MOV (SP)+,R3 ;RECOVER OFFSET NEG R3 CMP R3,EQVH3 ;COMPARE TO AVAILABLE ROOM BLE EQUE75 ;BR=>ENUF ROOM ETRAP 98. ;"ILLEGAL EXTENSION OF COMMON BASE" EQUE75: RTS PC .GLOBL OUTLN,EOL EQUE74: .BYTE '. EQUE73: .BYTE TAB,'=,0 .EVEN ;NON-COMMON TYPE EQUIVALENCE - NO INTERACTION WITH ;COMMON TABLES .GLOBL PUTNAM,BITM,MISC,OUTGL,OUTNAM,OUTCOM EQUE80: JSR PC,GNTR$S ;$TR,$SNNNN IF NEEDED .GLOBL GNTR$S MOV EQVCLS,R0 ;EQUIVALENCE CLASS MOV #EQUER ADBFLG ;CLEAR ADB NEEDED FLG BIT #PSHMKM,PSHWD(R5) ;IS ADB NEEDED? BEQ QA00 ;NO - LEAVE FLAG CLEAR INC ADBFLG ;YES - NOTE FOR EASY TESTING MOV R0,R3 ;OUTPUT MOV #'A,R0 ; THE ADB JSR PC,OUTSER ; LABEL JSR PC,OUTCOL ;FOLLOWED JSR PC,OUTTAB ;BY A COLON AND A TAB BIT #010000,SERWD(R5) ;DO WE USE THE NAME? BNE CKAR01 ;NO MOV R5,R0 JSR R5,OUTCH2 ;FORCE THIS TO BE '+ ; A USER SYMBOL JSR PC,OUTST ;OUTPUT THE NAME CKAR02: JSR PC,EOL ;OUTPUT AN END OF LINE QA00: MOV ADBPWD(R1,R1 ;TEXT POINTER TRAP+24. ;DEPTH EXCEEDED!!!?! BR SVSP03 ; SVSP01: .ASCIZ / $SVSP/ SVPA0: .ASCIZ / $SVPA/ SVE: .ASCIZ / $SVE/ TLGTH: .BYTE 2,2,2,4,8.,8. .SBTTL FUNCTION CALL PROCESSING ; ; FUNCTION CALLS GET GENERATED HERE ; FUNCAL: MOV POLPTR,R5 MOV -(R5),R0 ;REMEMBER MOVB R0,DEPTH ;THE STORAGE LEVEL CURRENTLY USED MOV -(R5),R2 ;GET THE SERIAL NUMBER CALL GETTYP MOV R0,-(SP) FUNC13: MOV CURSYM,R0 BIT #040000,ENTYWD(R0) ;IS THIS AN AS81,R3 ;ROUTINE TO CALL JSR PC,EQUL00 ;THE USUAL LOOP JSR R5,OUTLN2 ;RESET TO LOCAL PC EQUE83 MOV EQVH1,R3 ;BY THIS AMOUNT ADD EQVH2,R3 SCLWB R3,139.; JSR PC,OUTOCT JSR PC,EOL ;THIS ENDS THIS CLASS. JSR R5,OUTLN2 ;EVEN UP EQUE87 ;THE PC .GLOBL GNTL$S JSR PC,GNTL$S ;$SNNNN=. JMP EQUE10 ;BACK TO BEGINNING ; ; FOR EACH VARIABLE FIX ITS POSITION IN THE OBJECT MODULE ; EQUE81: MOV @R1,R3 ;DON'T REPEAT IS ALREADY ALLOCATED ADD SYMBAS,R3 BIT #ALLMKM,ALLOWD(R3) BNE EQUE865),R5 ;GET ADB ADDRESS ADD SYMBAS,R5 ;ADD IN THE FUDGE FACTOR TST (R5)+ ;SKIP OVER FIRST WORD MOV (R5)+,R0 ;GET THE DESCRIPTOR WORD TST ADBFLG BEQ QA01 JSR PC,OUTTAB MOV R0,R3 JSR PC,OUTOCT ;OUTPUT THE DESCRIPTOR JSR PC,EOL QA01: ROL R0 ;GET ROL R0 ; THE # OF DIMENSIONS ROL R0 ; INTO R0 BIC #177774,R0 ;CLEAR THE EXTRANEOUS BITS MOV #1,-(SP) ;PRESET SIZE TO 1 CKAR03: MOV (R5)+,R3 ;GET A MOV (SP)+,R4 ;GET COUNT JSR PC,IMUL ;ACCUM .TITLE ENDSTM .IDENT /7.00/; DK,RG ; ;COPYRIGHT 1971,1972 DIGITAL EQUIPMENT CORPORATION ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT .GLOBL ZLEQLS,EXEC,NXTCH,ENDFND,SCAN2A,ENDFIL,END R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; "END" STATEMENT PRE-CHECK PROCESSOR ; END: JSR PC,ZLEQLS ;CHECK FOR ZERO LEVEL EQUAL BCC END002 ;NOT THERE END001: SEV ;OTHERWF CALL?? BNE F13A ;YES,SKIP THE GLOBAL GENERATION BIT #PARMKM,PARWD(R0) ;IS IT A PARAMETER? BNE FUNC14 ;YES JSR R5,OUTLN2 FUNC11 JSR PC,OUTST ;OUTPUT THE NAME JSR PC,EOL F13A: CNDGLB CALL OUTCOM JSR PC,OUTST BR FUNC15 ; ; CALL TO PARAMETER ; FUNC14: CNDGLB CALL OUTCOM MOV PARXWD(R0),R3 ;GET THE BIC #PARXMK,R3 ;INDEX AND JSR PC,OUTOCT ;OUTPUT IT FUNC15: JSR R5,OUTLN2 ;TRANSFER AROUND PAR LIST FUNC05 MOVB @POLPTR,R3 ;GET ;BR => ALREADY ALLOCATED BIS #ALLMKM,ALLOWD(R3) JSR PC,OUTSTX ;THE NAME OF THIS VARIABLE MOV FLT(R0),R3 SUB OFFSET(R1),R3 ADD EQVH2,R3 SCLWB R3,139.; JSR PC,OUTOCT ;USE IT JSR PC,EOL ;END THE LINE EQUE86: RTS PC ; EQUE83: .BYTE '. EQUE82: .BYTE TAB,'=,'.,'+,0 EQUE87: .ASCIZ '.EVEN' .EVEN ;LIST LOOK ;LINK THROUGH LIST GIVEN BY R0 (MAY BE EMPTY) - CALLING GIVEN ROUTINE ;FOR EACH ITEM ; INPUT R0 - ADDRESS OF FIRST GROUP ; ULATE ARRAY SIZE TST R2 ;DID IT GET TOO BIG? BNE PSHERR ;YES MOV R4,-(SP) ;SAVE SIZE INFORMATION TST ADBFLG BEQ QA02 JSR PC,OUTTAB ; COUNT JSR PC,OUTOCT ; ITEM AND OUTPUT IT JSR PC,EOL QA02: DEC R0 ;LOOP BGT CKAR03 ; AT MOST, THREE TIMES MOV (SP)+,R3 ;GET SIZE MOV (SP)+,R4 ;AND COMPUTE MOVB TYPSIZ(R4),R4 ;THE JSR PC,IMUL ;ACTUAL LENGTH MOV R4,R3 ;AND PLACE IN R3 MOV CURSYM,R0 BIT #170000,SERWD(R0) ;DO WE GENERATE THE ARRAY TOO? BNE PSHG1 ;NO BCS PSHERR ;ERRORISE NOT AN END ENDF2: RTS PC END002: JSR PC,NXTCH ;CHECK FOR A REAL END TST R2 BNE ENDF ;IT ISN'T AN END UNLESS INCB ENDFND; IT IS TERMINATED !! RTS PC; RETURN WITH 'END' FLAG SET ; ; HERE WE CHECK FOR ENDFILE BECAUSE OF A CROCK IN THE VERB SCAN ; ENDF: DEC R1 ;BACK UP THE POINTER MOV #ENDF1,R0 JSR PC,SCAN2A ;CHECK FOR "FILE" BVS ENDF2 MOV #1,EXEC ;MUST BE EXECUTABLE JMP ENDFIL ENDF1: E1 E2 0 E1: .ASCII /FILE/ E2 = . .EVEN .END THE PARAMETER COUNT ASL R3 ;CONVERT ADD #2,R3 ;TO A BRANCH OFFSET JSR PC,OUTOCT FUNC06: JSR PC,EOL ;DO END-OF-LINE TSTB DEPTH BEQ FUND01 FUNC03: MOV -(R5),R0 ;GET A WORD BIC #007777,R0 CMP #170000,R0 ;IS THIS AN INSERTED PARAMETER?? BEQ SPPAR CMP #NULARG,R0 ;IS IT NULL ARG? BEQ FUNNUL ;YES MOV @R5,R0 BPL FUNC01 BIT #400,R0 ;IS THE DEFINITION END? BNE FUNDON ;YES FUNC01: JSR PC,OUTTAB JSR R5,OUTCH2 '+ JSR PC,SERATR ;GET MOV CURSYM,R0 ;ADDRESS JSR PC,OUTST ;OUTR3 - ADDRESS OF ROUTINE TO CALL ; OUTPUT R0 - GROUP POINTER ; R1 - ITEM POINTER ;R2 AND R4 ARE UNTOUCHED AND MAY BE ;USED TO PASS PARAMETERS EQUL00: MOV R3,-(SP) MOV R0,-(SP) BR EQUL01 EQUL03: MOV @SP,R0 MOV @R0,R0 MOV R0,@SP EQUL01: BEQ EQUL02 MOV R0,R1 ;GET FIRST ITEM ADD #4,R1 ;THE REAL POINTER BR EQUL04 EQUL05: MOV @R1,R1 BEQ EQUL03 EQUL04: MOV R1,-(SP) ;SAVE AGAINST ALL ASSULTS MOV R0,-(SP) TST (R1)+ ;POINT TO THE STEX NOT THE LINK JSR PC,@6(SP) MOV (SP)+,R0 MOV IF ARRAY TOO BIG MOV R3,-(SP) ;REMEMBER SIZE TEMPORARILY ASR R3 ;CONVERT TO WORD COUNT JSR PC,TSTPSH ; THE BRANCHES!! JSR PC,OUTST JSR PC,OUTCOL JSR PC,EOL JSR R5,OUTLN2 ;OUTPUT THE ARRAY GENP4 MOV (SP),R3 ; WITH JSR PC,OUTOCT ; IT'S SIZE JSR PC,EOL ; INFORMATION. BIT #1,(SP)+ ;IS IT ODD LENGTH?? BEQ PSHG1 ;NO JSR R5,OUTLN2 ;YES, OUTPUT A PSH006 ; ".EVEN" PSHG1: MOV (SP)+,R0 PSHG3: BR PSHGEN CKR01: BR CKARY PSHERR: TRAPUT NAME OF SYMBOL BR FUNC06 ;OUTPUT THE NAME ; ; PUT OUT ODD ADDRESS AT TOP OF MEMORY ; TO AVOID MISUSE ; FUNNUL: CALL OUTLN2, ;"-1" BR FUNC06 ; SPPAR: MOV @R5,R3 ;GET THE SERIAL BIC #170000,R3 ;AND MOVB #'F,R0 JSR PC,OUTSER ;OUTPUT THE LABEL JSR R5,OUTLN2 ;OUTPUT THE REST OF THE LINE FUNC07 BR FUNC06 ;AND OUTPUT IT ; FUNDON: MOV (R5),R2 CALL SAVCVT ;REMEMBER CONVERSION IF SPECIFIED MOVB DEPTH,R3 ;GET CURRENT DEPTH ASL R3 ;CONVERT TO WORD POINTER MOV FNS (SP)+,R1 BR EQUL05 EQUL02: ADD #4,SP RTS PC ; EQVBDS ; ; CHECK THE SUBSCRIBTS USED IN EQUIVALENCE/DATA ; ARE WITHIN DECLARED LIMITS ; INPUT - R1 = ADDRESS OF ENTRY ; R3 = PSEUDO ADB (SUBSCRIPTS) ; OUTPUT- C-BIT = 0 => ALL OKAY ; C-BIT = 1 => N.G. ; EQVBDS: MOV R4,-(SP) MOV R2,-(SP) MOV R3,-(SP) JSR PC,SIZDIM ;BASED ON R3 BEQ EQVBD0 MOV R4,-(SP) ;# DIMENSIONS FROM PSEUDO ADB MOV ADBPWD(R1),R1 ;GET REAL ADB BEQ EQVBD5 P+88. ;ARRAY TOO BIG? BR PSHG1 ;YEP!! ; ; END OF COMPILATION PROCESSING ; ENDPRO: JSR PC,CLROVR ;RESET OVERLAY STACK .GLOBL CLROVR .GLOBL EXEC,BLKDAT TST EXEC ;EXECUTABLES STARTED? BNE 1$ ;YES .GLOBL ALOCAT,ALOKAT TSTB ALOKAT ;IF ALLOCATION ALREADY DONE, BNE 2$ ;THEN DON'T BOTHER TO DO IT AGAIN JSR PC,ALOCAT ;ALLOCATE COMMON/EQUIVALENCE 2$: TST ROUTIN ;IS THIS A MAIN PROGRAM? BNE 1$ ;NO TST BLKDAT ;IS IT BLOCK DATA? BNE 1$ .TITLE ERRLOC .IDENT /0601/ ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ;FORTRAN SYNTAX ERROR PROCESSOR ;ENTERED WHEN ERRORS ARE ENCOUNTERED VIA A ;TRAP+N INSTRUCTION WHERE N IS THE DIAGNOSTIC NUMBER ; ; ; R1=%1 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL SYNERR,ERRCUR,ERREND,ERRS,ALOKAT .PSECT ZZZHGH SYNERR: MOV R4,-(SP) MOV R5,-(SP) MOV ERRCUR,R5 ;FIND NEXT AVAILABLE ENTRY CMP R5,#ERREND ;IS TABLE FULL BHIS SYN01 ;BR IF YES MOV R1,(R5)+ ;ELSE, PUTTK(R3),R0 ;GET THE STACK FUDGE FACTOR BEQ FUND01 ;NONE CLR FNSTK(R3) ;CLEAR THE COUNT JSR R5,OUTLN2 ;OUTPUT THE ADD MNEMONIC FUNC02 MOV R0,R3 ;NOW OUTPUT JSR PC,OUTOCT ;THE COUNT JSR PC,EOL BR FUND05 FUND01: JSR R5,OUTLN2 FUNC09 FUND05: TST -(R5) MOV R5,POLPTR MOV (SP)+,CURTYP CLRB DEPTH INC EXTFLG RETURN .NLIST BEX ; FUNNUT: .ASCIZ / -1/ FUNC04: .ASCIZ / $CALL/ FUNC17: .ASCIZ / $CALLP/ FUNC05: .BYTE 15,12 .ASCII / BR .+/ .BYTE 0 FUNC07: .ASCII /: 0/ .BYTE 0 ADD SYMBAS,R1 EQVBD2: MOV R1,R3 ;# DIMENSIONS FROM REAL ADB JSR PC,SIZDIM CMP R4,(SP)+ BNE EQVBD1 ;BR => DIMENSIONS NOT THE SAME MOV (SP),R2 ; ADD #4,R1 ADD #4,R2 TST R4 ;COUNTER EQVBD3: BEQ EQVBD0 CMP (R1)+,(R2)+ BLT EQVBD1 DEC R4 BR EQVBD3 EQVBD0: CLC ;INDICATE ALL OKAY EQVBD4: MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R4 RTS PC EQVBD5: MOV (SP)+,R4 EQVBD1: SEC BR EQVBD4 ; ;MOVE GROUP FROM EQVHED LIST ;TO EQVCLS LIST ; INP ;YES TRAP+134. ;NO EXECUTABLES IN THE MAIN!!? 1$: .GLOBL DOLST TST DOLST ;ANY DO ENTRIES PENDING? BEQ ENDP3 ;NO TRAP+114. ;MISSING TERMINATIONS ENDP3: JSR PC,SYN3ER ;PRINT ANY DIAGNOSTICS OCCURING TST BLKDAT ;BLOCK DATA?? BNE GENBRX ;YES END004: TSTB LINENO ;ANY LINE NUMBER? .GLOBL LINENO BNE 1$ ;YES TSTB GOFLG ;CAN THIS EVER BE EXECUTED? .GLOBL GOFLG BNE END006 ;NO, CAN'T GET TO END STATEMENT ;SO DON'T GENERATE ANYTHING 1$: TST ROUTIN ;JUMP BEQ END005 ; IF CURRENT R1 IN TABLE ;NEXT GET ERROR #. MOV 4(SP),R4 ;GET CONTENTS OF PC AT TIME OF TRAP MOV -(R4),R4 ;GET ACTUAL TRAP INSTR. BIC #177400,R4 ;ISOLATE ERROR # CMP R4,#43. ;IS THIS AN OVERFLOW ERROR? BNE SYN02 ;NO MOVB #-1,ALOKAT ;SET ERROR FLAG SYN02: CMP R4,-4(R5) ;SAME DIAGNOSTIC AS LAST ONE ;PUT INTO TABLE? BEQ SYN01 ;IF SO, DON'T ENTER IT, ;DON'T UPDATE ERRCUR MOV R4,(R5)+ ;INTO TABLE MOV R5,ERRCUR ;SAVE TABLE POINTER SYN01: MOV (SP)+,R5 ;RESTORE REGS MOV (SP)+,RFUNC02: .ASCII / .GLOBL $RPOLN/ .BYTE 15,12 .ASCII / JSR %4,$RPOLN/ .BYTE 15,12,11 .BYTE 0 FUNC09: .ASCII / .GLOBL $RPOL0/ .BYTE 15,12 .ASCII / JSR %4,$RPOL0/ .BYTE 15,12,0 FUNC11: .ASCII / .GLOBL / .BYTE 0 .EVEN .SBTTL INTERNAL STACK PUSHES AND POP ; ; ; PG: CALL PSC PSHGEN #COD.G,CURTYP RETURN ; ; ; ; PR: CALL PSC PSHGEN #COD.R,CURTYP RETURN ; ; PUSH CORE ITEN ONTO COD GEN STACK ; PCX: CALL P2R ;PARAMETER ADDRESS TO R0 UT: R0 = LIST PREDECSSOR ; OUTPUT: R4 = GROUP MOVED ; EQUZ00: MOV #EQVCLS,R4 EQUZ02: TST @R4 BEQ EQUZ01 MOV @R4,R4 BR EQUZ02 EQUZ01: MOV @R0,@R4 ;SHIFT POINTS MOV @0(R0),@R0 ;FIX EQUALED LIST CLR @0(R4) ;END OF EQVCLS RTS PC ; ; SAME AS EQUZ00 EXCEPT THAT ON ENTRY ; R0 = ADDRESS OF GROUP TO BE MOVED ; (RATHER THAN OF GROUP ; BEFORE THE GROUP TO BE MOVED) ; EQUZ10: MOV R0,R4 ;MUST SEARCH FOR PREVIOUS GROUP MOV #EQVHED,R0 EQUZ11: CMP @R0,R4 BEQ EQUZ00 MAIN PROGRAM CLR -(SP) ;FAKE AN END-OF-LINE STRING MOV SP,R1 ;FOR THE 'RETURN' PROCESSOR JSR PC,RETURN ;GENERATE A RETURN TST (SP)+ ;GET RID OF FAKE LINE BR END006 ;AND CONTINUE GENBRX: JMP GENDON END005: JSR PC,GENLAB ;GET THE LABEL JSR R5,OUTLN2 ;GENERATE THE $EXIT ENDP2 .GLOBL SYN3ER END006: CLRB GOFLG CLR R0 PSHGEN: INC R0 ;ADVANCE TO NEXT SERIAL NUMBER CMP R0,SERIAL ;HAVE WE CHECKED THE WHOLE LIST? BGT GENBR ;YES, EXIT CMP ROUTIN,#2 ;IS THIS A FUNCTION? BEQ PSHG2 4 RTI .END IF NEEDED PSHGEN #COD.C,WORKI RETURN ; PF=PS PS: CALL P2S PSHGEN #COD.S,CURTYP RETURN ; PP: CALL PSC PSHGEN #COD.P,WORKI RETURN ; PSC: CALL R2S CALL G2S CALL P2S RETURN ; FAIL1: JMP ERR200 ; POP: SAVREG MOV R0,-(SP) CALL POPITM BCS FAIL1 MOV LTARG,RTARG MOV LTCOD,RTCOD MOV R2,LTARG MOV R1,LTCOD CMP #COD.C,R1 BEQ 1$ CMP #COD.P,R1 BNE 2$ 1$: CALL GETTYP MOV R0,CURTYP 2$: MOV (SP)+,R0 RETURN .SBTTL INTERNAL  ;BR => GO TO PREVIOUS CASE MOV @R0,R0 BR EQUZ11 ;GUARENTEED TO TERMINATE IF CORRECTLY ;CALLED WITH OKAY LIST STRUCTURE ; ;OUTSTX ; OUTSTX: MOV R0,-(SP) ;MUST WORK FROM R0 MOV @R1,R0 ;NAME COMES FROM R1 JSR PC,OUTSTR JSR R5,OUTLN2 EQUE82 MOV (SP)+,R0 ;CLEAN HOUSE. RTS PC ; ; OUTSTS ; ; OUTPUT FROM SYMBOL TABLE RELATIVE - BUT JUGGLE THE ; REGISTERS FIRST TO EVERYBODY HAPPY ; OUTSTS: MOV R0,-(SP) MOV R4,R0 JSR PC,OUTSTR MOV  ;YES, DON'T SKIP THE FUNCTION NAME CMP R0,NAMSER ;IS THIS THE ROUTINE NAME? BEQ PSHGEN ;YES, SKIP IT PSHG2: JSR PC,SERATR ;FIND OUT ABOUT GOODIES BVS PSHGEN ;ALL DONE WHEN OVERFLOW OCCURS CMP R3,#1 ;IS THIS AN ARRAY? BEQ CKR01 ;YES .IF NDF COM8K BGT FUNC ;JUMP IF A FUNCTION CALL .IFF BGT PSHGEN .ENDC MOV R0,-(SP) ;SAVE SERIAL NUMBER MOV R3,-(SP) ;SAVE CLASS MOV R0,R3 ;GET THE SERIAL NUMBER MOV CURSYM,R0 BIT #PSHMKM,PSHWD(R0) ;I STACK STATE CHANGES ; ;REGISTER 0 POINTED ITEM TO EXECUTION STACK ; R2S: SAVREG MOV STKPTR,R3 2$: CALL GETITM BCS 1$ CMP R1,#COD.R BEQ 3$ TST (R3)+ BR 2$ ;HAVE AN ITEM 3$: MOV #COD.S,R1 CALL PLCITM CALL GEN$GT 1$: RETURN ; ;PARAMETER ITEM TO EXECUTION STACK ;CAN ONLY BE ON TOP OF CODE GEN STACK ; P2S: MOV STKPTR,R3 CALL GETITM BCS PEXIT CMP #COD.P,R1 BNE PEXIT CALL GEN$P P2RS: MOV R0,R2 MOV #COD.S,R1 CALL PLCITM PEXIT: RETURN ; ; ; ;PARAMETER ITEM TO R0 AT (SP)+,R0 RTS PC .END S A PUSH NEEDED? BEQ NOPSH ;NO MOV #'P,R0 ;AND THE MNEMONIC JSR PC,OUTSER ;GENERATE A LABEL JSR R5,OUTLN2 ;GENERATE PART OF PSHA01 ;THE PROTOTYPE CMP R2,#6 ;IS IT ASCII?? BEQ PSHG4 ;YES CMP R2,#3 ;IS IT REAL?? BEQ PSHRL2 ;YES BGT PSHDBX ;NO, HANDLE DOUBLE/COMPLEX PSHG4: MOV CURSYM,R0 ;IT IS INTEGER/LOGICAL/BYTE TST (SP) ;IS IT A CONSTANT?? BMI PSH13A ;YES TST R2 ;IS IT LOGICAL *1? BNE 1$ ;BR=>NO MOV #'B,R4 ;USE 'MOVB' JSR PC,OUTCHR 1$: JSR PC,OUTTAB BIT #P .TITLE ERRPRT .IDENT /0402B/ ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT, L. COHEN ; ; FORTRAN SYNTAX ERROR PROCESSOR - ; .MCALL .TRAN,.WAIT,.PARAM ; .GLOBL SYN3ER,DBUF,SRCLIN,CODE,SRCLEG,MTOP .GLOBL DIAG,LINKSL,LINKOL,DPTR .GLOBL DBUF,OUTPUT,ECNT,DIFILE .GLOBL ERRCUR,ERRS,ERREND .IF NDF COM8K .GLOBL RUNER .ENDC .CSECT ; .PARAM ;REGISTER DEFS, ETC. ; ; ; THIS PROCESSOR OUTPUTS SOURCE LANGUAGE DIAGNOSTICS ; TO THE OUTPUT SOURCE AND OBJECT DEEXECUTION ; P2R: MOV STKPTR,R3 CALL GETITM BCS PEXIT CMP #COD.P,R1 BNE PEXIT CALL GEN$PA MOV R0,R2 MOV #COD.R,R1 CALL PLCITM RETURN ; ;ITEM IN R0-R3 TO STACK ; G2S: MOV STKPTR,R3 2$: CALL GETITM BCS 1$ ;DONE LOOKING FOR COD.G CMP #COD.G,R1 BEQ 3$ ;FOUND A COD.G TST (R3)+ ;ADVANCE STACK POINTER BR 2$ ; 3$: MOV #COD.S,R1 CALL PLCITM ;PUT COD.C IN STACK SLOT CALL GEN$PR ;TO DO CODE OUTPUT 1$: RETURN .SBTTL INTERNAL STACK M .TITLE EXECUT .IDENT /0710/ ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; .GLOBL GETLN,SCANNR,EXEC,EXECUT .GLOBL MAIN,HDR,BLKDAT,BLKD .GLOBL SCAN2A,GETSW,ASGN,SEQNO,SCANX .GLOBL ALOCAT,SRCLIN,ENDPRO,DODON,ENDFND .GLOBL LINENO,INHLAB,EXDSP,IFDSP,EXRET .CSECT ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; SPACE = 40 ; ; EXECUT IS THE ARMKM,PARWD(R0) ;IS IT A PARAMETER? BEQ PSHPI ;NO JSR PC,PSHP ;YES, GENERATE SPECIAL FORM BR PSH014 PSHPI: JSR PC,OUTST ;OUTPUT SYMBOL NAME PSH014: JSR R5,OUTLN2 ;ADD THE REST OF THE INSTRUCTION PSH004 JSR R5,OUTLN2 ;NOW OUTPUT THE JUMP ITSELF PSH005 PSHEND: MOV #3,R4 JSR PC,TSTPSH NOPSH: TST @SP ;CHECK CLASS BEQ GENVAR ;IF VARIABLE GO HANDLE IT MOV (SP)+,R3 MOV CURSYM,R0 ;GET SYMBOL TABLE ENTRY ADDRESS MOV (R0),R4 ;GET NUMBER OF DATAVICES. ;ENTERED ONCE PER STATEMENT, AFTER IT IS PROCESSED. ;OUTPUTS DIAGNOSTICS AS PER ENTRIES IN THE ;DIAGNOSTIC TABLE ; ; INSTRUCTION WITH ALL CONDITIONS AND REGISTERS AS BEFORE ; ; REGISTERS CHANGED - NONE. ; SYN3ER: CMP ERRCUR,#ERRS ;ANY ERRORS? BNE SYN2S ;YES RTS PC ;NO SYN2S: MOV R0,-(SP) MOV R1,-(SP) ;SAVE ALL MOV R2,-(SP) ; REGISTERS MOV R3,-(SP) ; SO I CAN MOV R4,-(SP) ; USE I/O HANDLERS WITHOUT MOV R5,-(SP) ; DISTURBING COMPILATION MOVB #15,DBUF ;OUTPUT A ANAGEMENT ROUTINES ; ;PLACE ITEM IN STACK ;INPUT: R3-STACK ADRESS ; R1-COD.X VALUE (RIGHT ADJUSTED) ; R2-OTHER INFO (" ") ;OUTPUT: C-BIT=0 IF DONE ; C-BIT=1 IF ADRESS OUT OF BOUNDS ; PLCITM: CALL STKLIM BCS 1$ SWAB R1 ASHL 4,R1 BIS R2,R1 MOV R1,@R3 1$: RETURN ; ; GET ITEM FROM STACK ; ARGS AS IN PLCITM ; GETITM: CALL STKLIM BCS 1$ MOV @R3,R2 MOV R2,R1 BIC #170000,R2 SWAB R1 ASHR 4,R1 BIC #177760,R1 1$: RETURN ; ; CHECK THAT STACK POINTER IS OKAY ; STKLIMAIN EXECUTABLE CONTROL ; LOOP FOR THE COMPILER. IT CALLS ; GETLN FOR A LINE OF TEXT AND THEN DISPATCHES TO ; THE PROPER STATEMENT HANDLER. ; ; EACH STATEMENT HANDLER IS DISPATCHED TO BY A "JSRPC,XXX". ; UPON ENTRY TO THE HANDLER, R1 POINTS TO THE CHARACTER ; WHERE THE RECOGNITION SCAN LEFT OFF. ; ; EACH HANDLER IS, IN GENERAL, RESPONSIBLE FOR COMPLETE ; PROCESSING OF THE REMAINDER OF THE LINE, UP TO AND ; INCLUDING THE TERMINATOR BYTE. ; ; RETURN FROM THE HANDLER IS AS FOLLOWS: A NORMAL ;  ITEMS BIC #177400,R4 MOV R4,-(SP) ;SAVE THEM INC R4 ;ROUND VALUE ASR R4 ;TO NEAREST WORD CMP R2,#6 ;ASCII? BNE 1$ ;NO INC R4 ;ADD ASCII FUDGE FACTOR 1$: JSR PC,TSTPSH ;MAKE SURE ROOM IS SUFFICIENT JSR PC,OUTST ;OUTPUT SYMBOL NAME JSR PC,OUTCOL ;OUTPUT A COLON MOV CURSYM,R0 ;GET MOV (SP)+,R5 ADD #VALUE,R0 ;GET POINTER TO VALUE PSHLP: JSR PC,OUTTAB ;OUTPUT A TAB MOV (R0)+,R3 ;GET A WORD OF VALUE JSR PC,OUTOCT ; AND OUTPUT THE VALUE JSR PC,EOL ; AND AN END OF LINE  MOVB #12,DBUF+1 ;AND A MOV #2,R5 ;COUNT IS TWO JSR PC,OUTDGN ;OUTPUT A BLANK LINE ; ;INITIALIZE POINTER TO ERROR TABLE SYN106: MOV #ERRS,DIPTR SYN105: MOV @DIPTR,R1 ;PICK UP 1ST VALUE OF R1 BEQ SYN04B ;IF 0 THEN SKIP SOURCE LINE PRINTING .IF NDF COM8K .GLOBL LSTVAL TST LSTVAL ;IS THIS THE MINIMUM LIST? BNE SYN301 ;NO SUB #15.,R1 ;YES, BACK UP 15 CHARS INSTEAD BR SYN300 .ENDC SYN301: SUB #8.,R1 ;BACK UP CHARACTER POINTER SYN300: CMP R1,SRCLIN ;DID I BACK UP TOO FAR?? BM: CMP R3,STKBEG BHI 1$ CMP R3,STKPTR BLO 1$ CMP R3,STKEND BLO 2$ ;STACK OVERFLOW CLC RTS PC 1$: SEC RETURN ; 2$: CLR R1 TRAP+129. JMP FAIL ; ; PUSH ITEM ONTO STACK ; R1 AND R2 AS IN PLCITM ; PSHITM: MOV STKPTR,R3 TST -(R3) CMP R3,STKEND BLO 1$ MOV R3,STKPTR CALL PLCITM RETURN 1$: CALL ERR201 ; POPITM: MOV STKPTR,R3 CALL GETITM BCS 1$ ADD #2,STKPTR CLC 1$: RETURN ; ;GENERATE PUSH CALL FOR SERIAL NUMBER IN R2 ; GEN$P: SAVREG CALL OUTTAB MOV RRETURN WILL RETURN USING A "RTS PC" WITH THE V-BIT ; OF THE STATUS WORD CLEAR. A RETURN WITH THE V-BIT ; SET MAY ONLY OCCUR IF THE LINE IN QUESTION COULD ; NOT BE OF THE ASSUMED TYPE. ; ; EXAMPLE: COMMON=1 IS A LEGAL STATEMENT, BUT ; THE COMMON PROCESSOR WOULD FIND IT ; UNRECOGNIZABLE SO THE PROCESSOR WOULD SET THE ; V-BIT BEFORE RETURNING. ; ; THE IMPLICIT AND TYPE PROCESSORS ARE ENTERED ; AS ABOVE EXCEPT THAT R0 CONTAIS THE MODE OF ; THE IMPLICIT OR TYPE STATEMENT ; REGISTERS CHANGED  SUB #2,R5 ;DECREMENT DATA COUNT BGT PSHLP ;LOOP UNTIL VALUE COMPLETE CMP R2,#6 ;IS IT ASCII? BNE PSHG5 ;NO CLR R3 ;YES, SO OUTPUT JSR PC,OUTTAB JSR PC,OUTOCT ;A WORD OF JSR PC,EOL ;ZEROS PSHG5: MOV (SP)+,R0 ;REMEMBER SERIAL NUMBER BR PSHGEN ;GO BACK TO MAIN LOOP GENBR: JMP GENDON ;MID-WAY BRANCH PSH13A: JSR PC,OUTTAB BR PSH013 .IF NDF COM8K FUNC: JMP FNC01 ;INTERMEDIATE JUMP FOR FUNCTION SUMMARY .ENDC PSHDBX: JSR PC,OUTTAB BR PSHDHIS 1$ ;NO 2$: MOV SRCLIN,R1 ;RESET POINTER 1$: MOV SRCLIN,R0 ;IS R1 PAST ADD SRCLEG,R0 ;END OF LINE CMP R1,R0 ;BUFFER? BHIS 2$ ;IF YES, THEN RESET IT MOV #CHARS,R0 ;GET ADDRESS OF SUBSTITUTION CHARS. MOV #DBUF,R2 ;GET ADDRESS OF ERROR BUFFER MOVB (R0)+,(R2)+ ;TRANSFER "<" .IF NDF COM8K TST LSTVAL ;IS THIS THE MINIMUM LIST? BNE SYN302 ;NO MOV #30.,R3 ;YES, OUTPUT MANY CHARS. BR SYN002 ; .ENDC SYN302: MOV #11.,R3 ;GET COUNT SYN002: DEC R3 ;DECREMENT COUNT BEQ SYN004 2,R3 MOV #'P,R0 CALL OUTSER CALL EOL CALL GETTYP MOV CURSYM,R2 BIS #PSHMKM,PSHWD(R2) RETURN ; ;GET TYPE OF ITEM WHOSE SERIAL # IS IN R2 ; ; FOR THE PURPOSES OF ARITHMETIC ROUTINES ; HOLLERITH ITEMS (TYPE 6) ARE TREATED AS INTEGER ; (TYPE 2). TYPE 7 IS ILLEGAL. ; GETTYP: SAVREG MOV R2,R0 CALL SERATR BVS FAIL02 MOV @CURSYM,R0 SWAB R0 ASHR 3,R0 BIC #177770,R0 CMP R0,#6 ;HOLLERITH? BLT 1$ ;NO - LEAVE AS IS BGT FAIL02 ;ERROR MOV #2,R0 ;TREAT 6 AS 2 1$: RETURN - ALL. ; SCANX: TST EXEC ;EXECUTABLES ALREADY STARTED? BNE SCANR ;YES JMP SCANNR ;NO GO BACK TO NON-EX END00: CLR LINENO TRAP+39. ;MISSING END STATEMENT END01: JMP ENDPRO ;LINKAGE TO END HANDLER SCANNE: TSTB ALOKAT ;DO WE NEED TO ALOCATE? .GLOBL ALOKAT BNE SCANE ;NO JSR PC,ALOCAT ;NO, GO ALLOCATE COMMON SCANE: TST EXEC BNE SCANR MOV #1,EXEC ;SET EXECUTABLE FLAG .GLOBL OLDHGH,FRHIGH,FRLOW,OLDLOW MOV OLDHGH,R1 ;RESET THE HIGH CORE POIBL PSHRL2: JSR PC,OUTTAB BR PSHRL .GLOBL SERWD GENVAR: MOV 2(SP),R0 ;GET SERIAL NUMBER JSR PC,SERATR ;GET MODE MOV CURSYM,R0 BIT #170000,SERWD(R0) ;DO I DARE GENERATE VAR?? BNE GENEX ;NO BIT #PARMKM,PARWD(R0) ;PARAMETER? BNE GENEX ;YES MOV R2,-(SP) ;YES JSR PC,OUTST ;GENERATE A NAME MOV (SP)+,R2 ;RESTORE R2 BNE GV1 ;NOT TYPE LOGICAL*1 GV1B: MOV #GENP1,R4 ;SET UP MOV #1,R0 ;BYTE VAR. BR GENC GV1: CMP R2,#4 ;FOUR WORD? BGE GV2 ;EXIT WHEN DONE MOVB (R1)+,R4 ;GET A CHARACTER BEQ SYN004 ;EXIT IF END OF LINE CMP R4,#40 ;IS IT A CONTROL CHARACTER?? BGE SYN003 ;NO, GO TRANSFER IT MOVB #'^,(R2)+ ;YES, TRANSFER "^" ADD #100,R4 ;CONVERT TO CHARATER SYN003: MOVB R4,(R2)+ BR SYN002 ;GO FOR 10 IF POSSIBLE SYN004: MOVB (R0)+,(R2)+ ;TRANSMIT BNE SYN004 ;REMAINDER OF PERMANENT MESSAGE DEC R2 SUB #DBUF,R2 ;GET CH. COUNT + 1 MOV R2,R5 ;SET UP COUNT JSR PC,OUTDGN SYN04B: MOV #DBUF,R2 ;GET BUFFER ADDRESS MOV #! FAIL02: JMP ERR202 ; ; ; GEN$PA: SAVREG CNDGLB <$PA,MISC+6,BITM+7> CALL OUTCOM CALL GETTYP MOV CURSYM,R2 MOVB @R2,R3 CALL OUTOCT CALL EOL RETURN ; ; ; GENERATE EXECUTION MOVE FROM R0-R3 TO STACK ; INPUT R2=TYPE ; OUTPUT R0=TYPE ; GEN$PR: SAVREG CNDGLN R2,#GL1+4,#PSHR GENC1: CALL EOL MOV R2,R0 RETURN ; $PA: .ASCIZ / $PA/ PSHR: .ASCIZ / $PSHR/ GET: .ASCIZ / $GET/ .EVEN ; GENPR: MOV CURTYP,R2 BR GEN$PR ; ; GENERATE MOVE FROM ITEM R0 POINTS TO STACK ; GEN"NTER MOV FRHIGH,OLDHGH ;TO RECOUP THE SPACE MOV R1,FRHIGH ;NO LONGER NEEDED FOR COMMON STUFF. MOV FRLOW,OLDLOW ;REMEMBER LOW END TOO SCANR: CMP ERRCUR,#ERRS ;ANY ERRORS IN THE STATEMENT? BEQ SCANR1 ;NO JSR PC,SYN3ER ;PRINT THEM .GLOBL SYN3ER,ERRCUR,ERRS SCANR1: TSTB ENDFND; TEST IF 'END' HAS OCCURRED ALREADY BNE END01; YES - GO TO 'ENDPRO' INC SEQNO ;ADVANCE SEQUENCE NUMBER JSR PC,GETLN ;GET A LINE OF TEXT BVS END00 ;ASSUME END IF EOF OR EOM #;YES CMP R2,#3 ;REAL? BEQ GV1A ;YES CMPB TYPSIZ(R2),#4 ;INTEGER*4? BNE GV1B ;NO GV1A: MOV #GENP2,R4 ;SET UP MOV #2,R0 ;LOGICAL,INTEGER, OR REAL BR GENC GV2: MOV #GENP3,R4 ;SET UP MOV #4,R0 ;DOUBLE, COMPLEX GENC: JSR PC,OUTLN1 ;OUTPUT THE CHARACTERS MOV R0,R4 JSR PC,TSTPSH GENEX: MOV (SP)+,R3 MOV (SP)+,R0 JMP PSHGEN PSH013: ADD #VALUE,R0 ;SINGLE DATA WORD ITEM JSR R5,OUTCH2 ;OUTPUT THE '# ;IMMEDIATE MODIFIER MOV (R0)+,R3 ;OUTP$CHERR,R0 ;POINT TO "ERROR" TEXT ADD #2,DIPTR ;ADVANCE FOR NEXT MESSAGE SYN04A: MOVB (R0)+,(R2)+ ;STORE THE BNE SYN04A ;WORD "ERROR" DEC R2 ;CONVERT ERR. # TO DECIMAL ASCII, PUT INTO DBUF FOR OUTPUT MOV @DIPTR,-(SP) MOV R2,-(SP) MOV R2,R5 MOV #3,-(SP) EMT 42 MOV #5,R3 SYN101: DEC R3 ;DON'T WIPE OUT THE BLE SYN103 ;WHOLE NUMBER (00000) CMPB @R5,#'0 ;GET RID BNE SYN103 ;OF THE MOVB #' ,(R5)+ ;LEADING BR SYN101 ;ZEROS SYN103: MOVB (R0)+,DBUF+12 MOVB (R0)+,DBUF+13 MOV %$GT: SAVREG CNDGLN R2,#GL1+3,#GET BR GENC1 ; ; CSTK - CONDITIONAL STACK OPERATION ; ; LOOK AT THE ARGUMENT IN LTARG AND ; FORCE IT TO THE RUN TIME STACK IF NEEDED. ; CSTK: SAVREG MOV LTCOD,R1 MOV #COD.S,LTCOD MOV LTARG,R2 ASL R1 CALL @CSTKT(R1) MOV R0,LTARG RETURN ; CSTKT: ERR206 ;NULL GEN$P ;CORE ITEM CSTK1 ;ALREADY ON STACK GEN$GT ;R0 POINTER CSTK1 ;IN F0, ALSO ON STACK GEN$PR ;IN R0-R3 GEN$P ;PARAMETER ERR206&EXECUT: MOV SRCLIN,R1 ;REMEMBER WHERE LINE STARTS MOVB #1,GETSW ;SET UP GET SWITCH MOV #EXTBL,R0 ;ADDRESS OF EXECUTABLE PROTOTYPES JSR PC,SCAN2A ;GO SEARCH FOR PROTOTYPE BVS SCAN10 ;JUMP IF NOT FOUND SCAN05: JMP EXDSP ;GO TO EXECUTABLE DISPATCHING EXRET: ;RETURN HERE FROM EXECUTABLE DISPATCHING BVC SCAN22 SCAN10: MOV SRCLIN,R1 ;RESET POINTER JSR PC,ASGN ;GO DO ASSIGNMENT STATEMENT SCAN16: BVS SCANX SCAN22: TSTB LINENO ;CHECK FOR LINE NUMBER .GLOBL LINENO BEQ SCANNE ;NO LI'UT THE JSR PC,OUTOCT ; VALUE JMP PSH014 ;RETURN TO LOOP PSHDBL: MOV DLAB,R5 BNE PSHDB1 ;LABEL ASSIGNED MOV FLABL,DLAB ;ASSIGN NEW LABEL INC FLABL MOV #-120.,DPC ;RESET PC BR PSHDBL ;TRY AGAIN PSHDB1: MOV #PSH007,R2 ;SET "DOUBLE" TAIL PSHCOM: MOV CURSYM,R0 ;OUTPUT BIT #PARMKM,PARWD(R0) ;PARAMETER?? BEQ PSHC1 ;NO JSR PC,PSHP1 ;YES, GENERATE SPECIAL FORM JSR R5,OUTLN2 PSH012 CMP R2,#PSH007 ;IS IT REAL?? BNE PSHC2 ;NO INC DBLT ;SE(#14,R5 ;# CHARS TO OUTPUT JSR PC,OUTDGN ;WRITE TO LIST AND OBJ DEV INC ECNT ;INCREMENT GLOBAL ERROR COUNTER ; IF DIAG FILE NOT PRESENT, DON'T TRY TO PRINT ; MESSAGE TST DPTR BNE SYN107 BR SYN108 SYN15A: BR SYN105 ; ;ROUTINE TO GET THE DIAGNOSTIC NEEDED ; SYN107: MOV SP,R3 ;SEE IF ROOM FOR SUB DPTR+2,R3 ;DIAGNOSTIC BUFFER CMP R3,MTOP ;? BLOS SYN108 ;NO - SKIP TEXT DIAGNOSTIC MOV R3,SP ;YES - PROCEED MOV R3,DTRN+2 ;GET WORD ADDRESS TO BLOCK MOV DPTR,DTRN ;GET DISK ADDRESS ) ERR206 ERR206 ERR206 CSTK1: MOV R2,R0 ;ALREADY ON STACK RETURN ; ; CSTKR - SIMILAR TO CSTK BUT WORKS ON RIGHT ARG ; CSTKR: SAVREG MOV RTCOD,R1 MOV #COD.S,RTCOD MOV RTARG,R2 ASL R1 CALL @CSTKT(R1) MOV R0,RTARG RETURN .SBTTL CONDITIONAL GLOBL STATEMENT GENERATION ; ; ; GBL: .ASCIZ / .GLOBL / ; ; GBLTL: .ASCIZ <6>/CSRFDG/ GBLTR: .ASCIZ <6>/CSRK1G/ GBLTD: .ASCIZ <3>/CSR/ GBLTO: .ASCIZ <4>/ASMD/ GBLTM: .ASCIZ <3>/IRD/ .EVEN *NE NUMBER JSR PC,DODON ;GO HANDLE DO ENDINGS BR SCANNE ;OVERLAY TRANSFER VECTOR .GLOBL OVJMP OVJMP: TST (SP)+ ;GET RID OF OLD OVERLAY'S RET ADDR TST INHLAB ;TEST IF DISPATCHING FOR LOGICAL 'IF' BEQ SCAN05 ;NO JMP IFDSP ;YES - GO TO 'IF' DISPATCHING ; ; TABLE OF EXECUTABLE PROTOTYPES - THIS IS A DUAL TABLE, THE FIRST ; PART POINTS TO THE ASCII IN THE SECOND PART. EACH TABLE ; MUST BE TERMINATED BY A ZERO. ; .NLIST BEX .GLOBL IFTAB EXTBL:+T THE SPECIAL DOUBLE FLAG BR PSHC3 PSHC2: INC RLT ;SPECIAL REAL FLAG PSHC3: JSR R5,OUTLN2 PSH017 MOV R5,R3 ;NOW MOV #'F,R0 ;OUTPUT THE LABEL JSR PC,OUTSER JSR R5,OUTLN2 PSH011 BR PSHC4 PSHC1: JSR R5,OUTCH2 '# JSR PC,OUTST ; THE SYMBOL NAME MOV R2,R4 ;GET CODE "TAIL" JSR PC,OUTLN1 ; IS OUTPUT HERE MOV R5,R3 MOV #'F,R0 JSR PC,OUTSER PSHC4: JSR PC,EOL ;GENERATE END OF LINE JMP PSHEND ;GO BACK TO MAIN LOOP PSHRL: MOV RLAB,R5 ,MOV DPTR+2,DTRN+4 ;GET BYTE COUNT ASR DTRN+4 ;CONVERT TO WORD COUNT MOV @DIPTR,R5 ;GET THE ERROR NUMBER BIC #177400,R5 ;CLEAR HIGH BIT SWAB R5 ;MULTIPLY CLC ;(REMEMBER SIGN BIT) ROR R5 ; BY ASR R5 ; 64. CLR R4 ;CLEAR COUNT SYN220: CMP R5,DPTR+2 ;IS THE REMAINDER SMALL ENOUGH???? BLT SYN221 ;YES INC R4 ;ADVANCE COUNT SUB DPTR+2,R5 ;DO A SUBTRACT BR SYN220 SYN221: ADD R4,DTRN ;GET ACTUAL BLOCK ADDRESS ADD R3,R5 ;GET POINTER TO THE DIAGNOSTIC .GLOBL DGBLK .TRAN #DGB- EXPGBL: +EXPBIT,GBLTL,GBLTR,GBLTD,GBLTO,GBLTM,0 ; ; ; FOR MOVE OPERATION ; MOVGBL: +MOVBIT,GBLMVR,GBLMVD,GBLMVO,GBLMVT,0 ; GBLMVR: .ASCIZ <6>/CRSK1G/ GBLMVD: .ASCIZ <2>/CR/ GBLMVO: .ASCIZ <1>/V/ GBLMVT: .ASCIZ <6>/BLIRDC/ .EVEN ; ; ; FOR SUBSCRIPT OPERATION ; ARYGBL: +ARYBIT,GBLXS,GBLXB,GBLXO,GBLXZ,0 ; GBLXS: .ASCIZ <6>/CRSPGK/ GBLXB: .ASCIZ <2>/CA/ GBLXO: .ASCIZ <1>/X/ GBLXZ: .ASCIZ <5>/01248/ .EVEN ; ; QGLOB - CONDITIONAL GLOBAL GENERAT. E6 E8 E12 E12A IFTAB: E1 E2 E3 E9 E10 E11 E13 E14 E15 E16 E17 E17A E17B E18 E19 E20 E21 0 ; END OF PART 1 ; ; START OF PART 2 E6: .ASCII /END/ E8: .ASCII /FORMAT/ E12: .ASCII /DO/ E12A: .ASCII /DEFINEFILE/ E1: .ASCII /ASSIGN/ E2: .ASCII /CALL/ E3: .ASCII /CONTINUE/ E9: .ASCII /RETURN/ E10: .ASCII /GOTO/ E11: .ASCII /IF(/ E13: .ASCII /PAUSE/ E14: .ASCII /STOP/ E15: .ASCII /READ/ E16: .ASCII /PRINT/ E17: .ASCII /WRITE/ E17A: .ASCII /ENCODE/ E17B:/ BNE PSHRL1 ;JUMP IF LABEL ASSIGNED MOV FLABL,RLAB ;ASSIGN INC FLABL ; NEW LABEL MOV #-120.,RPC ;AND BR PSHRL ;TRY AGAIN PSHRL1: MOV #PSH008,R2 ;POINT TO "REAL" TAIL BR PSHCOM GENDON: MOV FNCHED,R5 ;GET CURRENT CHARACTER POINTER BEQ 99$ ;SKIP IF NO SUMMARY SUB #DOLST,R5 ;FORM CHAR COUNT MOV #DOLST,R4 ;TEXT POINTER .GLOBL OUTLST,LINCT INC LINCT ;ACCOUNT FOR TWO LISTING LINES JSR PC,OUTLST ;TO LISTING DEVICE CLR FNCHED ;TERMINATE BUFFE0LK,#DTRN ;GET THE BLOCK OF DIAGNOSTICS .WAIT #DGBLK ;WAIT FOR COMPLETION MOV R5,R4 ;PUT ADDRESS IN PROPER REGISTER TO C SYN202:;MOVE ENGLISH MESSG FOLLEWD BY CR-LF ; TO LIST AND OBJ DEVICES ;MOVE MSSG TO DBUF MOV #DBUF,R5 .IF NDF COM8K CMPB (R4),#'F ;IS THIS A FATAL MESSAGE? BNE SYN211 ;NO INCB RUNER ;YES, INHIBIT EXECUTION .ENDC SYN211: CMP R5,#DBUF+64. ;LOOP OVER? BHIS SYN210 ;BR IF YES MOVB (R4)+,(R5)+ ;ELSE, MOVE NXT CH. BR SYN211 SYN210: CMPB -(R5),#' ;DELETE BEQ SYN21ION ; ; INPUT - R3=POINTER TO TABLES TO USE ; - R0=POINTER TO ZERO TERMINATED NAME STRING ; (FIRST BYTE,$,IS IGNORED) ; QGLOB: SAVREG MOV R0,-(SP) MOV (R3)+,-(SP) MOV R3,R1 CLR R2 ;ACCUMULATE BIT NUMBER IN R2 3$: INC R0 MOV (R1)+,R3 ; BEQ 6$ MOVB (R3)+,R4 CLR R5 1$: ADD R2,R5 DEC R4 BNE 1$ MOV R5,R2 CLR R5 2$: INC R5 TSTB @R3 BEQ 5$ CMPB (R3)+,@R0 BNE 2$ ADD R5,R2 BR 3$ ; NOW TAKE BIT NUMBER IN R2 AND MAKE INTO BYTE ; OFFSET IN R3 AND BIT WITH IN BYT2 .ASCII /DECODE/ E18: .ASCII /REWIND/ E19: .ASCII /BACKSPACE/ E20: .ASCII /FIND/ E21 = . .EVEN ; END OF PART 2 ; ;THE JUMP TABLE FOR THIS ROUTINE IS INCLUDED IN THE PROGRAM ;OR OVERLAY HEADER ; .END 3R GOODIES 99$: MOV #200.,R4 JSR PC,TSTPSH ;FORCE OUT THE LAST BIT OF CODE ; ; OUTPUT THE GLOBALS NECESSARY TO HOOK UP TO THE OTS. ; .GLOBL BITM,MISC GEND4: MOV #MISC+4,R5 ;GET ADDRESS OF ITEM BITB #143,(R5) ;ANYTHING AT ALL TO DO? BEQ GEND3 ;NO BITB #140,(R5) ;ANY ENCODE/DECODE STUFF? BNE 1$ ;YES JSR R5,OUTLN2 GL ;OUTPUT THE GLOBAL BITB BITM+0,(R5) ;DO WE NEED A READ? BEQ GEND2 ;NO BICB BITM+0,(R5) JSR R5,OUTLN2 ;OUTPUT THE RD 410 ;TRAILING BLANKS INC R5 ADD DPTR+2,SP ;RESTORE THE STACK TO NORMAL MOVB #015,(R5)+ ;APPEND CR/LF MOVB #012,(R5)+ SUB #DBUF,R5 ;GET CHARACTER COUNT JSR PC,OUTDGN SYN108: ADD #2,DIPTR CMP DIPTR,ERRCUR ;MORE TABLE ENTRIES TO PROCESS? BLO SYN15A ;BR IF YES CMP DIPTR,#ERREND ;IF NOT, WAS THERE OVERFLOW?? BEQ SYN15A ;YES, PRINT OVERFLOW MESSAGE SYN008: SYN007: MOV #ERRS,ERRCUR ;REINITIALIZE DIAGNOSTIC TABLE MOVB #15,DBUF ;OUTPUT MOVB #12,DBUF+1 ;AND PACKED MOV #2,R5 5E IN R2 6$: MOV R2,R3 BIC #177770,R2 ASHR 3,R3 ADD (SP)+,R3 BITB BITM(R2),@R3 BNE 4$ ;GLOBL ALREADY GENERATED BISB BITM(R2),@R3 CALL OUTLN2, MOV (SP)+,R4 CALL OUTLN1 CALL EOL RETURN 4$: TST (SP)+ RETURN 5$: JMP ERR204 ; ; ; JSR R5,CNDGLB ; +TEXT ; +BIT MAP BYTE ADDRESS ; +BIT ; CNDGLB: MOV (R5)+,R4 CALL PUTNAM MOV (R5)+,R4 BITB @(R5),@R4 BNE 1$ BISB @(R5),@R4 CALL OUTGL CALL EOL 1$: CALL OUTNAM MOV -4(R5),R4 7;$READ 3$: MOV #ILIN,R0 ;GO SET UP JSR PC,SETIO ;INPUT GLOBALS BR GEND4 1$: BITB #100,(R5) ;DECODE? BEQ 2$ ;NO BICB #100,(R5) BR 3$ 2$: BICB #40,(R5) ;CLEAR ENCODE FLAG BR GEND2A GEND2: BITB BITM+1,(R5) ;DO WE NEED A WRITE? BEQ GEND3 ;NO BICB BITM+1,(R5) ;CLEAR THE WRITE FLAG JSR R5,OUTLN2 ;GENERATE A WRITE WT GEND2A: MOV #OLIN,R0 ;GO SET UP JSR PC,SETIO ;THE OUTPUT GLOBALS BR GEND4 GEND3: TST BLKDAT ;BLOCK DATA ? BNE GEND5 ;YES JSR R5,OUTLN2 ;OUTPUT .GLOBL $OTSV EN8 ;COUNT OF TWO JSR PC,OUTDGN ;OUTPUT A BLANK LINE MOV (SP)+,R5 ;RESTORE MOV (SP)+,R4 ; REGISTERS MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ;AND RETURN TO COMPILER ;OUTPUT WHATEVER IS IN THE DIAGNOSTIC BUFFER, DBUF ;COUNT IS IN R5. OUTPUT GOES TO OBJECT AND LIST DEVICE ;COUNT SHOULD NOT INCLUDE LEADING ";" OUTDGN: .IF NDF COM8K .GLOBL PAG JSR PC,PAG ;ADVANCE THE PAGE .ENDC MOV R5,-(SP) ;SAVE COUNT FOR 2ND CALL INC R5 ;BUMP R5 TO INCLUDE SEMICOLON MOV #S9 TST (R5)+ RTS R5 ; ; CONDITIONAL GENERATION OF YET ANOTHER FLAVOR ; ; INPUT -R2 = TYPE (0 TO 5) ; -R3 = BYTE ADDRESS OF BIT TABLE ; -R4 = TEXT ADDRESS OF NAME ; OUTPUT -R0 = TYPE ; CNDGLN: SAVREG CALL PUTNAM MOV R2,R4 ADD #60,R4 CALL PUTCHR BITB BITM(R2),@R3 BNE 1$ BISB BITM(R2),@R3 CALL OUTGL CALL EOL 1$: CALL OUTNAM MOV R2,R0 RETURN .SBTTL STATE DISPATCH TABLE ; ; STATE TRANSITION TABLE ; STATAB: $NULL,$ONE,$TWO : .TITLE EXTERN ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 SPACE=40 .GLOBL GET,CURSYM,ENTYWD,OUTLN2,OUTST .GLOBL EXTERN,EOL,NXTCH,ENTYMM,PARMKM,PARWD .GLOBL NAMMKM,NAMWD EXTERN: JSR PC,GET ;GET THE SYMBOL NAME BVS EXTERR ;BAD NAME TST R3 ;IS IT LEGAL? BMI;DPR2 GEND5: JSR R5,OUTLN2 ;OUTPUT END PROTOTYPE ENDPR1 .GLOBL ROUTIN TST ROUTIN ;IS THIS THE MAIN PROGRAM? BNE GEND1 ;NO TST BLKDAT ;NO TRA BNE GEND1 ;FOR BLOCK DATA JSR R5,OUTLN2 ;OUTPUT THE TRA ADDRESS ENDP1 GEND1: JSR PC,EOL ;AND AN END OF LINE .GLOBL OUTFIN JSR PC,OUTFIN ;EMPTY SMALL BUFFER JMP EXIT ;GO DO EXIT PROCESSING ; ; TSTPSH: TST DLAB ;ANY NEED FOR GENERATION?? BEQ GPSH2 ;NO ADD R4,DPC ;ADVANCE DOUBLE PC BMI GPS<YN006,R4 ;PTR TO DESCRIPTOR OF OBJ DEV. JSR PC,OUTPUT MOV (SP)+,R5 ;RECALL COUNT MOV #SYN005,R4 ;PTR TO DESCR FOR LIST DEV JSR PC,OUTPUT RTS PC CHARS: .BYTE '[,'],15,12,0 CHERR: .ASCII /ERROR/ .BYTE 0,15,12 ; .EVEN ; ;TRAN BLOCK ; DTRN: .BLKW ;START BLOCK .BLKW ;CORE ADDRESS .BLKW ;WORD COUNT 4 ;INPUT 0 ;RESERVED ; DIPTR: .BLKW ;SCRATCH POINTER ; ;I/O DESCRIPTORS - ;SYN005=LIST FILE, DBUF (MINUS LEADING ";") ;SYN006=OBJECT FILE, DBUF (INCLUDING LEADING ";") SYN005=; ; $TWO: +BOP.,BOP +OOP.,OOP +TOP.,TOP ; $ONE: +END.,TMV +SVS.,SVSP +COM.,COMMA +CVT.,MODCVT +UOP.,UOP ; $NULL: +FNC.,FUNC +ARY.,ARRAY +PAR.,PSHOPP +PSH.,PSHOPC +CAL.,FUNCAL ERROR0: 0 .SBTTL MNEMONIC DEFINITIONS ; ;DEFINITIONS ; COD.C =1 ;ITEM COD.S =2 ;ITEM ON STACK COD.R =3 ;ITEM POINTED TO COD.F =4 ;ITEM IN FPP REG COD.G =5 ;ITEM IN GEN REGS COD.P =6 ;PARAMETER ITEM COD.A =7 ;ADB REFERENCE COD.K =8. ;CONSTANT REFERENCE C> EXTERR ;NO CMP R3,#2 ;IS IT AN ARRAY BEQ EXTER1 ;YES, ERROR MOV CURSYM,R0 ;NOW BIT #NAMMKM,NAMWD(R0) ;IS THIS THE ROUTINE NAME? BNE EXTER2 ;YES, ERROR BIC #ENTYMM,ENTYWD(R0) ;SET BIS #100000,ENTYWD(R0) ; THE EXTERNAL BIT BIT #PARMKM,PARWD(R0) ;IS IT A PARAMETER? BNE EXT1 ;YES, DON'T GENERATE .GLOBL JSR R5,OUTLN2 ;GENERATE THE GLOBAL HDR3 JSR PC,OUTST ;OUTPUT THE SYMBOL NAME JSR PC,EOL EXT1: JSR PC,NXTCH ;GET A CHARACTER .GLOBL NXTCH CMPB R2,#', ;IS THERE MORE?? BEQ ?H2 ;DON'T DO ANYTHING YET MOV R4,-(SP) MOV R0,-(SP) ;SAVE R0 TST DBLT ;IS THIS A SPECIAL DOUBLE? BEQ GPSH4D ;NO CLR DBLT ;TURN OFF THE FLAG JSR R5,OUTLN2 ;OUTPUT THE SPECIAL GOODIES PSH015 GPSH4D: MOV DLAB,R3 ;GET THE LABEL MOV #'F,R0 ;OUTPUT JSR PC,OUTSER ;ROUTINE NAME JSR PC,OUTCOL JSR R5,OUTLN2 ;OUTPUT THE PSH009 JSR R5,OUTLN2 ; CODE PROTOTYPE PSH009 TST RLAB ;CAN WE IMBED A "REAL" IN IT?? BEQ GPSH4B ;NO TST RLT ;IS IT SAFE? BNE GPSH4B ;NO, DON'T ALLOW SPECI@: CODE LINKSL SYN006: DIAG LINKOL ; .END AOD.1 =9. ;CONSTANT 1 REFERNCE COD.B =10. ;ARRAY+OFFSET REFERENCE COD.D =11. ;USE DESTINATION TYP.L =1 ;LOGICAL TYP.I =2 ;INTEGER TYP.R =3 ;REAL MODE TYP.D =4 ;DOUBLE REAL MOD TYP.0 =6 ; OP.NOT =3 ;.NOT. OP.A =4 ;ADD OP.S =5 ;SUBTRACT OP.M =6 ;MULTIPLY OP.D =7 ;DIVIDE OP.PWR =10 OP.LT. =12 OP.GT. =13 OP.EQ. =14 OP.NE. =15 OP.LE. =16 OP.GE. =17 OP.X =10 ;SUBSCRIPT OPERATOR OP.V =12 ;MOVE OPERATOR OP.NEG =11 ;UNARY MINUS PSH. =1 ;NORMAL PUSH PAR. =2 ;PARAMETER ARY. =3 ;ARRAY BEGIN CBEXTERN ;YES TST R2 ;IS THIS END OF LINE?? BEQ EXTDON ;YES TRAP+12. ;NO, END OF LINE ERROR EXTDON: RTS PC EXTERR: TRAP+58. BR EXT1 EXTER1: TRAP+87. ;ARRAY IS BAD NEWS BR EXT1 EXTER2: TRAP+116. ;PROGRAM NAME IS BAD NEWS BR EXT1 ; HDR3: .ASCII / .GLOBL / .BYTE 0 .EVEN ; .END CAL CASES HERE MOV RLAB,R3 ;GENERATE MOV #'F,R0 ; A "REAL" JSR PC,OUTSER ; LABEL JSR PC,OUTCOL ;OUTPUT A COLON CLR RLAB ;RESET MOV #-120.,RPC ;REAL POINTER GPSH4B: CLR DLAB MOV #-120.,DPC GPSH4C: MOV (SP)+,R0 ;RESTORE R0 JSR R5,OUTLN2 ;GENERATE PSH009 ; THE JSR R5,OUTLN2 ; REMAINDER PSH009 ; OF JSR R5,OUTLN2 ; THE PSH005 ; PROTOTYPE MOV #7,R4 ADD (SP)+,R4 TST RLT ;SHALL WE CHECK REAL? BNE GPSH2 ;YES GPSH4A: REOM. =4 ;COMMA FNC. =5 ;FUNCTION BEGIN UOP. =6 ;UNARY OPERATOR BOP. =7 ;BINARY (NO-OPT) OOP. =8. ;OPTIMIZABLE OPE TOP. =9. ;" " END. =10. ;END OF POLISH CVT. =11. ;CONVERSION SVS. =12. ;SVSP CAL. =13. ;FUNCTION CALL ; ; SOME CHARACTERS FOR THE ABOVE CODES ; CODLET: .ASCII /?CSRFGPAK1CD/ ;YES C NOT B ON END OPRLET: .ASCII /????ASMDX?V/ TYPLET: .ASCII /BIIRDC012?4???8/ .EVEN ; STRARY =177401 ;START OF ARRAY STRFNC =177402 ;START OF FUNCTION COMMAC =177403 ;COMMA CODE NULARG =1600GTS PC ; ; GPSH2: TST RLAB ;ANYTHING TO DO?? BEQ GPSH4A ;NO ADD R4,RPC ;ADVANCE REAL PC BMI GPSH4A ;NOTHING TO DO YET CLR -(SP) ;PUT NULL FUDGE ON STACK MOV R0,-(SP) ;SAVE R0 TST RLT ;CHECK FOR SPECIAL REAL BEQ GPSH2A ;NOT SPECIAL CLR RLT JSR R5,OUTLN2 PSH016 GPSH2A: MOV RLAB,R3 MOV #'F,R0 ;GENERATE JSR PC,OUTSER ; THE LABEL JSR PC,OUTCOL ;FOLLOWED BY A COLON CLR RLAB MOV #-120.,RPC ;RESET POINTER BR GPSH4C ;GO TO FINISH UP ; DBLT: 0 RLT: 0 H .TITLE FORMAT .IDENT /0504/ ;RFB ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; MODIFIED JAN 1973 TO: ; ELIMINATE DOS DEPENDENCY IN NUMERIC CONVERSION ; ADD FLAGGING OF A FORMAT FOR CONDITIONAL LOADING ; ADD FORMAT VARIABLE EXPRESSIONS ; .GLOBL OUTCH2,OUTLN2,GOFLG .GLOBL FORMAT,GENLAB,PUTNAM,BITM,MISC .GLOBL OUTGL,EOL,OUTNAM,OUTCOM,FLABL,OUTSER .GLI00 ;NULL ARGUMENT CODE SVSPCD =104000 ;SVSP CODE .SBTTL TRACE AND INTERNAL ERROR ROUTINES ; ;TRAC ROUTINE ; TRACE: SAVREG TST DMPFLG ;TO TRACE OR NOT? BEQ 5$ ;NO CALL EOL MOV R0,EXTFLG MOV #TRACET,R2 2$: MOV R2,R4 CALL OUTLN1 1$: TSTB (R2)+ BNE 1$ BIT #1,R2 BEQ 4$ INC R2 4$: MOV (R2)+,R3 BIT #1,R3 BEQ 3$ BIC #1,R3 MOV @R3,R3 3$: MOV @R3,R3 CALL OUTOCT CALL EOL TST @R2 BNE 2$ CALL EOL MOV EXTFLG,R0 CLR EXTFLG 5J .TITLE FUNNAM ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; ; ; CHECK MODE OF SPECIAL CLASS OF FUNCTIONS, AND RESET ; TYPE IF NECESSARY. IF THE FUNCTION NAME MATCHES AND ; THE EXPLICITLY TYPED BIT IS NOT SET THE TYPE ; MAY BE SAFELY CHANGED. ; .GLOBL TFUN,SYM1WD,SYM2WD,DATYMM,DATYWD .GLOBL CURSYM,EXPMKM,EXPWD ; R0 = %0 R1 = %1 R2 = %2 K; PSHP: JSR R5,OUTCH2 ;OUTPUT AN INDIRECT '@ PSHP1: MOVB PARXWD(R0),R3 ;GET THE INDEX BIC #177400,R3 ;OUTPUT JSR PC,OUTOCT ; THE INDEX JSR R5,OUTLN2 ;NOW PUT OUT TNE REST OF THE PSH010 ;JUNK RTS PC SETIO: MOV #BITM+2,R1 ;SET UP MOV #MISC+4,R2 ;FOR WHIRLWIND CHECK OF GLOBALS BITB (R1)+,@R2 ;DO WE NEED A DOUBLE CONVERSION? BEQ SETIO2 ;NO JSR R5,OUTLN2 GL JSR R5,OUTLN2 ;GENERATE THE DOUBLE CONV. DC MOV R0,R4 ;SET THE JSR PC,OUTLN1 ;I/O TYPE NEEDED LOBL OUTCHR,LINENO,OUTLN,OUTCOL,NXTCH .GLOBL CNXC,SUBEXP,EXPGEN .CSECT R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ;FORMAT HANDLER ; FORMAT: INCB GOFLG ;UNLABELED FORMATS ARE BAD JSR PC,GENLAB ;GENERATE A LABEL MOV #FMT001,R4 ;OUTPUT JSR PC,PUTNAM ;SAVE THE $TR BITB BITM+4,MISC ;SEE IF GLOBAL ALREADY EXISTS BNE FORM09 ;IT DOES BISB BITM+4,MISC ;SET IT EXISTING JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ;AND END OF LINE FOM$: RETURN ; .MACRO MS A,B .ASCIZ /A/<11> .EVEN +B .ENDM TRACET: MS <;POLPTR:>,POLPTR MS <;@POLPTR:>,POLPTR+1 MS <;STK DEPTH:>,STKDTH MS <;POL CLASS:>,EXTFLG MS <;T.O.S.:>,STKPTR+1 MS <;CURTYP:>,CURTYP MS <;CVT:SER:OPR:>,WORKI MS <;CONVRT:>,CONVRT 0 ; ; INTERNAL ERROR REPORTING ; FAILT: .ASCIZ <15><12>/;INTERNAL ERROR / .EVEN ; ERR206: INC EXTFLG ;FROM 'CSTK' ERR205: INC EXTFLG ;FROM 'DSPTCH' ERR204: INC EXTFLG ;FROM 'QGLOB' NR3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 .CSECT ; TFUN: MOV R0,-(SP) ;SAVE MOV R1,-(SP) ;R0 AND R1 MOV CURSYM,R0 ;GET SYMBOL ADDRESS BIT #EXPMKM,EXPWD(R0) ;IS IT EXPLICITLY TYPED?? BNE TF004 ;YES, SO EXIT NOW MOV #FUNLST,R1 ;ADDRESS OF LIST TO SEARCH TF001: CMP SYM1WD(R0),(R1)+ ;DOES FIRST WORD MATCH BNE TF002 ;NO CMP SYM2WD(R0),(R1)+ ;DOES SECOND MATCH BEQ TF005 ;YES TF003: CMP R1,#FUNEND ;IS THE SEARCH DONE?? BLO TF001 ;NO TF004: MOV (SP)+,R1 ;RESTORE R1 MOV (SP)+,R0 ;AO BITB (R1)+,@R2 ;DO WE NEED INTEGER? BEQ SETIO5 ;NO SETIO3: JSR R5,OUTLN2 GL JSR R5,OUTLN2 ;OUTPUT INTEGER CONVERSION IC MOV R0,R4 ;SET THE JSR PC,OUTLN1 ;I/O TYPE BITB (R1)+,@R2 ;DO WE NEED LOGICAL? BEQ SETIO1 ;NO SETIO4: JSR R5,OUTLN2 GL JSR R5,OUTLN2 ;OUTPUT LOGICAL LC MOV R0,R4 ;AND ITS JSR PC,OUTLN1 ; TERMINATOR SETIO1: RTS PC SETIO2: BITB (R1)+,@R2 ;CHECK INTEGER BNE SETIO3 SETIO5: BITB (R1)+,@R2 ;CHECK LOGICAL BNE SETIO4 RTS PC PRM09: JSR PC,OUTNAM ;NOW OUTPUT THE NAME JSR PC,OUTCOM MOV FLABL,R3 ;GET NEEDED LABEL MOV R3,-(SP) ;REMEMBER FOR FINISH UP INC FLABL MOV #'F,R0 ;AND JSR PC,OUTSER ;OUTPUT IT JSR PC,EOL ;GENERATE END OF LINE JSR R5,OUTCH2 ;NOW PUT OUT '$ JSR R5,OUTLN2 ;THE FORMAT LINENO JSR PC,OUTCOL ; LABEL HERE MOV #40.,R5 ;GET CHARACTER COUNT CLR R3 ;SET PAREN COUNT TO ZERO JSR R5,OUTLN2 ;OUTPUT THE FMT004 ; .ASCII FMT000: MOV #CLIST,R4 ;Q ERR203: INC EXTFLG ;FROM 'SVSP' ERR202: INC EXTFLG ;FROM 'GETTYP/SERATR' ERR201: INC EXTFLG ;FROM 'PSHITM' ERR200: CALL OUTLN2, ;FROM 'POP' MOV EXTFLG,R3 ADD #200,R3 CALL OUTOCT CALL EOL ; FAIL: CLR R1 TRAP+147. ;INTERNAL ERROR INC DMPFLG CALL DUMP CALL TRACE DEC DMPFLG MOV FAILSP,SP JMP EXIT ; DUMP: SAVREG CMP #4,OPTLVL BHI 1$ SUB #4,OPTLVL INC DMPFLG 1$: TST DMPFLG BEQ 2$ CALL EOL MOV POLPTR,R2 TST (R2)+ 3$: MOV #';,R4 CALL OUTCHR MOV -(R2),RRND R0 AND RTS PC ;RETURN TF002: TST (R1)+ ;SKIP EXTRA WORD BR TF003 ;AND CONTINUE TF005: SUB #FUNLST+4,R1 ;GET THE TYPE INDEX ASR R1 ASR R1 ;HERE MOVB CHMOD(R1),R2 ;RESET THE TYPE BIC #DATYMM,DATYWD(R0) ;CLEAR OLD TYPE SWAB R2 BIS R2,DATYWD(R0) ;SET THE NEW TYPE SWAB R2 ASR R2 ASR R2 ASR R2 ;MODE IS NOW CORRECT IN R2 BR TF004 ;NOW EXIT ; ; FUNCTION NAMES FOLLOW HERE IN RADIX 50 ; FUNLST: .RAD50 /DAB/ ;DOUBLE .RAD50 /S/ .RAD50 /DMA/ ;DOUBLE .RAD50 /X1/ .RAD50 /DSS .IF NDF COM8K ; ;THIS ROUTINE IS USED TO OUTPUT A SUMMARY OF ALL FUNCTIONS AND ; SUBROUTINES WHICH ARE CALLED BY THE SUBJECT PROGRAM. ; .GLOBL ENTYWD,ENTYMK,UNPK00,SYM1WD FNC01: MOV R0,-(SP) ;SAVE THE SERIAL NUMBER MOV CURSYM,R0 ;IS THIS MOV ENTYWD(R0),R0 ;AN BIC #ENTYMK,R0 BIT #040000,R0 ;ASF??? BNE 99$ ;YES, SKIP IT!! TST FNCHED ;HAS THE HEADING BEEN PUT OUT? BNE 1$ ;YES MOV #HED,R4 MOV #HEDLGT,R5 JSR PC,OUTLST MOV #DOLST,FNCHED CLR FNCNAM ;CLEAR COUNT OTGET CHARACTER LIST FMT012: MOVB (R1)+,R2 ;GET A CHARACTER CMPB R2,#40 ;IGNORE ALL BEQ FMT012 ; BLANKS CMPB R2,(R4)+ ;IS IT AN OPEN PAREN? BEQ FMT014 ;YES CMPB R2,(R4)+ ;IS IT A CLOSED PAREN? BEQ FMT006 ;YES CMPB R2,(R4)+ ;IS IT A ' ? BEQ FRM10 ;YES CMPB R2,(R4)+ ; IS IT A . ? BEQ FMT002 ;YES CMPB R2,(R4)+ ;IS IT A , ? BEQ FMT002 ;YES CMPB R2,(R4)+ ;IS IT A /? BEQ FMT002 ;YES CMPB R2,(R4)+ ;IS IT A - ?? BEQ FMT002 ;YES, IS ALLOWED CMPB R2,(R4)+ ;IS IT A < BNE 13 BEQ 4$ CALL OUTOCT CALL EOL BR 3$ 4$: CALL EOL 2$: RETURN .END VI/ .RAD50 /GN/ .RAD50 /DBL/ ;DOUBLE .RAD50 /E/ .RAD50 /CMP/ ;COMPLEX .RAD50 /LX/ .RAD50 /CON/ ;COMPLEX .RAD50 /JG/ .RAD50 /DEX/ ;DOUBLE .RAD50 /P/ .RAD50 /CEX/ ;COMPLEX .RAD50 /P/ .RAD50 /DLO/ ;DOUBLE .RAD50 /G/ .RAD50 /CLO/ ;COMPLEX .RAD50 /G/ .RAD50 /DLO/ ;DOUBLE .RAD50 /G10/ .RAD50 /DSI/ ;DOUBLE .RAD50 /N/ .RAD50 /CSI/ ;COMPLEX .RAD50 /N/ .RAD50 /DCO/ ;DOUBLE .RAD50 /S/ .RAD50 /CCO/ ;COMPLEX .RAD50 /S/ .RAD50 /DSQ/ ;DOUBLE .RAD50 /RT/ .RAD50 /CSQ/WF NAMES 1$: MOV CURSYM,R0 ;FIND OUT ADD #SYM1WD,R0 ;WHERE THE NAME IS MOV FNCHED,R1 ;GET CURRENT STRING POINTER CMP R1,#DOLST ;IS THIS THE START OF THE LINE? BEQ 2$ ;YES MOVB #',,(R1)+ ;STORE A COMMA 2$: MOVB #TAB,(R1)+ ;FOLLOWED BY A TAB JSR PC,UNPK00 ;GET THE ASCII NAME INC FNCNAM ;ADVANCE COUNT OF NAMES CMP FNCNAM,#7. ;HAVE WE PUT OUT SEVEN? BLT 3$ ;NO SUB #DOLST,R1 ;GET CHARACTER COUNT MOV #DOLST,FNCHED ;RESET THE POINTER MOV R1,R5 X$ JMP FMTEXP ;DO FORMAT EXPRESSION 1$: CMPB R2,(R4)+ ;IS IT A A BEQ FMTA CLR R0 ;SET COUNT TO ZERO CMPB R2,(R4)+ ;IS IT A DIGIT? BLT FMT008 ;NO CMPB R2,(R4)+ ;CHECK AGAIN BLE FMT007 ;IT IS A DIGIT CMPB R2,(R4)+ ;IS IT A D?? BEQ FORM04 ;YES CMPB R2,(R4)+ ;IS IT AN E? BEQ FORM04 ; GO-O-O TEAM CMPB R2,(R4)+ ;HOW ABOUT AN F? BEQ FORM04 ;YEAH MAN, REALLY COOL CMPB R2,(R4)+ ;GIMME A G! BEQ FORM04 ; YEA TEAM INC R0 ;TRY NEXT POSSIBILITY CMPB R2,(R4)+ ;WE NEED AN I BEY .TITLE GCMPLX .GLOBL GCMPLX .GLOBL SYMNXT .CSECT ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY R. BRENDER, D. KNIGHT ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; ; GCMPLX ; ;ATTEMPT TO COLLECT A COMPLEX CONSTANT OF THE ;FORM: ; (REAL,REAL) ; ^ ;ENTER WITH R1 POINTING AFTER THE LEFT ;PAREN (REPEAT AZ ;COMPLEX .RAD50 /RT/ .RAD50 /DAT/ ;DOUBLE .RAD50 /AN/ .RAD50 /DAT/ ;DOUBLE .RAD50 /AN2/ .RAD50 /DMO/ ;DOUBLE .RAD50 /D/ FUNEND = . CHMOD: .BYTE 40,40,40,40,50,50 .BYTE 40,50,40,50,40,40,50,40 .BYTE 50,40,50,40,40,40 .EVEN .END [ MOV #DOLST,R4 ;TEXT POINTER JSR PC,OUTLST ;LIST IT CLR FNCNAM ;RESET THE NAME COUNT BR 99$ 3$: MOV R1,FNCHED ;REMEMBER CURRENT LINE POSITION 99$: MOV (SP)+,R0 ;RESTORE THE SERIAL NUMBER JMP PSHGEN ;AND GO BACK TO THE LOOP ; ; .IFTF .NLIST BEX .IFT HED: .ASCII <15><12>/ROUTINES CALLED:/ HEDLGT = .-HED .EVEN .IFTF FNCHED: 0+.-. FNCNAM: .BLKW .ENDC ; GL: .ASCII / .GLOBL / .BYTE 0 RD: .ASCII /$READ/ .BYTE 15,12,0 WT: .ASCII \Q FORM04 ; GOT IT!! CMPB R2,(R4)+ ;OR AN O TO CALL IT INTEGER BEQ FORM04 ;YEP, TWAS AN O INC R0 ;NOW WE TRY FOR LOGICAL CMPB R2,(R4)+ ;IT MUST BE AN L OR ELSE IGNORE IT BNE FMT002 ;TAIN'T LOGICAL, SO IGNORE IT FORM04: BISB BITM+2(R0),MISC+4 ;SET FLAG FOR PROPER MODE FMT002: TST R3 ;IS THE PAREN COUNT OK? BNE FMT013 ;YES TRAP+10. ;TELL HIM HE IS WRONG FMT013: JSR PC,TSTIT ;ADVANCE COUNT MOV R2,R4 ;OUTPUT THE JSR PC,OUTCHR ; CHARACTER BR FMT000 ;RE-LOOP FRM10: BR FORM10 ]FTER!) ;RETURN: IF AN ERROR - RESTORE R1 AND V=1 ; IF OKAY THEN R1 POINTS AFTER THE ) ; AND V=0. A COMPLEX CONSTANT ; IS IN THE SYMBOL TABLE POINTER ; AT BY CURSYM. ; ;NO ERROR MESSAGES ARE GIVEN SO THAT THE ;ROUTINE MAY BE CALLED TO "LOOK AHEAD" ;TO SEE IF A COMPLEX IS PRESENT. IF NOT, ;NOTHING IS CHANGED. ; ;IF C-BIT AND V-BIT BOTH SET ON RETURN THEN ;IT PROBABLY WAS AN ILL-FORMED COMPLEX - ;IE, A ; REAL, ;WAS CORRECTLY FOUND. .GLOBL NOCNSV,GET,CNXC,CURSYM,SYMBYT,LENWD,DATYMM .GL_/$WRITE/ .BYTE 15,12,0 DC: .ASCII /$DC/ .BYTE 0 IC: .ASCII /$IC/ .BYTE 0 LC: .ASCII /$LC/ .BYTE 0 ILIN: .ASCII /I/ .BYTE 15,12,0 OLIN: .ASCII /O/ .BYTE 15,12,0 ; ENDPR1: .ASCII / .END/ .BYTE 0 ENDPR2: .ASCIZ /.GLOBL $OTSV/<15><12> ENDP1: .ASCII / MAIN./ .BYTE 0 ENDP2: .ASCII / .GLOBL $EXIT/ .BYTE 15,12 .ASCII / $EXIT/ .BYTE 15,12,0 PSH001: .BYTE ': PSH002: .ASCII / MOV / .BYTE 0 PSH003: .ASCII / MOV -(%0)/ PSH004: .ASCII /,-(%6)/ .BYTE 15,12,0 PSH005: .ASCII /`FMT014: INC R3 ;INCREMENT PAREN COUNT BR FMT002 FMT006: DEC R3 ;DECREMENT PAREN COUNT BR FMT013 ;DON'T CHECK NESTING ON ) FMT008: TST R2 ;IS THIS END OF LINE? BEQ FMT009 TRAP+18. ;BAD CHARACTER IN FORMAT BR FMT000 ;RE-LOOP FMT009: TST R3 ;CHECK PAREN COUNT BEQ FMT010 ; OK BLT FMT011 ;TOO MANY RIGHT PARENS TRAP+59. ;TOO MANY LEFT PARENS FMT010: JSR R5,OUTLN2 ;OUTPUT THE FMT005 ;FINISH JSR R5,OUTLN2 ;UP FMT003 ;GOODIES MOV (SP)+aOBL DATYWD ; ;ATTEMPT TO COLLECT COMPLEX CONSTANT ; GCMPLX: MOV R1,-(SP) MOVB NOCNSV,-(SP) ;SAVE STATE THIS SWITCH INCB NOCNSV ;DON'T SAVE NEXT CONSTANT CLR -(SP) ;SET POSITIVE SIGN JUST IN CASE JSR PC,CNXC ;SKIP POSSIBLE BLANKS CMPB (R1),#'- ;MINUS SIGN?? BNE GC02 ;NO INC @SP ;SET MINUS INC R1 ;ADVANCE CHARACTER POINTER GC02: JSR PC,GET ;LOOK FOR REAL CONSTANT BVS GCMP90 ;PUNT TST R3 BGE GCMP90 ;BR=> NOT A CONSTANT CMP #3,R2 BNE GCMP90 ;BR=> NOT A REAL ; ;HAVE Tb .TITLE GENOVL .IDENT /0613/ ;CP ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; MODIFIED 28-NOV 1972 TO INCLUDE SUPPORT ; OF RP03 AS SYSTEM DEVICE. ; MODIFIED 26-JUL-73 TO VERIFY ACTUAL SIZE OF EACH OVERLAY ; DOES NOT EXCEED EXPECTED SIZE. ; ; ; THIS ROUTINE IS USED TO OUTPUT A COMPILER OVERLAY ; TO THE DISK IN IMAGE FORM ; .MCALL .INIT,.STAT,.ALLOC,.LOOK,.TRAN,.WAIT,.EXIT,.PARAM ; .PARAM ;REGISTER DEFS, ETC. ; .CSECT ; ; MAX ALLOCATABLE SIZE Fc JMP @(%4)+/ .BYTE 15,12,0 PSH006: .ASCII / .EVEN/ .BYTE 15,12,0 PSH007: .ASCII /+10,%0/ .BYTE 15,12 .ASCII / BR / .BYTE 0 PSH008: .ASCII /+4,%0/ PSH017: .BYTE 15,12 .ASCII / BR / .BYTE 0 PSH009: .ASCII / MOV -(%0),-(%6)/ .BYTE 15,12,0 PSH010: .ASCII /(%5)/ .BYTE 0 PSH011: .ASCII /-4/ .BYTE 0 PSH012: .ASCII /,%0/ .BYTE 0 PSH015: .ASCII / ADD #10,%0/ .BYTE 15,12,0 PSH016: .ASCII / ADD #4,%0/ .BYTE 15,12,0 GENP4: .ASCII /. = .+/ .BYTE 0 GENP1: .ASCII /: 0/ .BYTE 15,d,R3 ;GET $F VALUE MOV #'F,R0 ;OUTPUT JSR PC,OUTSER ;IT JSR PC,OUTCOL ;FOLLOWED BY JSR PC,EOL ;A COLON AND END OF LINE RTS PC ;AND RETURN ; ; A FORMAT ; FMTA: BISB BITM+0,MISC+6 ;FLAG A CONVERSION BR FMT002 ;AND KEEP SCANNING FMT011: TRAP+11. ;TOO MANY RIGHT PARENS. BR FMT010 FMT007: DEC R1 ;BACK UP CHARACTER POINTER MOV R1,-(SP) ;REMEMBER OLD TEXT POINTER JSR PC,D2B ;CONVERT DECIMAL TO BINARY BVS 1$ ;NUMBER IS TOO BIG JSR PC,OUTeHE BEGINNINGS ; JSR PC,CNXC CMPB #',,(R1)+ BNE GCMP90 ;NO JOINING COMMA MOV CURSYM,R0 ;SAVE CURRENT REAL VALUE TST (SP)+ ;IS THE SIGN NEGATIVE?? BEQ GC03 ;NO ADD #100000,SYMBYT(R0) ;YES, SET THE NEGATIVE SIGN GC03: MOV SYMBYT(R0),-(SP) MOV SYMBYT+2(R0),-(SP) CLR -(SP) ;SET POSITIVE SIGN JUST IN CASE JSR PC,CNXC ;SKIP BLANKS CMPB (R1),#'- ;IS IT NEGATIVE?? BNE GC04 ;NO INC @SP ;SET NEGATIVE SIGN INC R1 ;AND ADVANCE CHARACTER COUNT GC04: JSR PC,GET ;TRY FOR SECOND REfOR OVERLAYS ; .IF NDF COM8K SIZLST: 23000 ;OVERLAY 0 MAX SIZE 27000 ;OVERLAY 1 MAX SIZE 36000 ;OVERLAY 2 MAX SIZE 34000 ;OVERLAY 3 MAX SIZE 15000 ;OVERLAY 4 MAX SIZE OVCNT: 4 ;MAX OVERLAY NUMBER IS 4 .IFF ;8K SIZES SIZLST: 12000 ;OVERLAY 0 13000 ;OVERLAY 1 13000 ;OVERLAY 2 13000 ;OVERLAY 3 12000 ;OVERLAY 4 OVCNT: 4 ;MAX OVERLAY NUMBER IS 4 .ENDC ; .GLOBL BEG,TLB,FB0,OVLIST,LOWCOR .GLOBL OVTAB,LENGTH,OVLAY,RDCNTX,INIT ; INIT: .INIT #TLB ;INIT THE SYSTEM DEVICg12,0 GENP2: .ASCII /: 0,0/ .BYTE 15,12,0 GENP3: .ASCII /: 0,0,0,0/ .BYTE 15,12,0 PSHA01: .ASCIZ /: MOV/ .EVEN .END hNUM ;OUTPUT THE VALUE JSR PC,NXTCH ;GET NEXT CHARACTER CMPB R2,#'H ;IS IT HOLLERITH? BEQ FORM11 ;NO DEC R1 ;BACK UP POINTER JMP FMT000 1$: JSR PC,OUTNUM ;OUTPUT THE VALUE BR BADST FORM11: MOV R2,R4 ;OUTPUT THE H JSR PC,OUTCHR JSR PC,TSTIT TST R0 BEQ BADSTR CMP R0,#255. ;IS IT TOO LONG? BGT BADSTR ;YES FORM12: MOVB (R1)+,R4 ;GET A CHARACTER BEQ BADLGT ;BAD LENGTH JSR PC,OUTCHR ;OUTPUT IT JSR PC,TSTIT DEC R0 ;DONE? BGT FORMiAL BVS GCMP91 ;BR=> PUNT TST R3 BGE GCMP91 ;BR=>NOT CONSTANT CMP #3,R2 BNE GCMP91 ;NOT A REAL ;CLOSING DELIMITER? CMPB #'),(R1)+ BNE GCMP91 ;N.G. MOV (SP)+,R0 ;GET THE SIGN MOV (SP)+,R2 ;GET FIRST MOV (SP)+,R3 ;PART OF VALUE MOVB (SP)+,NOCNSV ;USE PREV. VALUE OF THIS SWITCH ;HAVE COMPLEX - MAKE A VALID ENTRY MOV R4,-(SP) ;EVALU EXPECTS R4 MOV R5,-(SP) ;AND R5 TO BE SAFE MOV CURSYM,R4 MOV SYMBYT+2(R4),-(SP) MOV SYMBYT(R4),-(SP) TST R0 ;IS THE SIGN NEGATIVE?? BEQ GjE .STAT #TLB ;AND FIND ITS CHARACTERISTICS CMP (SP)+,(SP)+ MOV (SP)+,BLKSIZ ;AND SAVE IT MOV #BEG,TBLK+2 ;CORE ADDRESS MOV #OVLAY,R2 ;THE MOV R2,LOWCOR ;PRESET LOW CORE ADDRESS .GLOBL OVLAY SUB #BEG,R2 ASR R2 ;WORD COUNT MOV R2,TBLK+4 ;IS SAVED TOO MOV #OVLIST,R0 ;GET ADDRESS OF OVERLAY DATA AREA MOVB (R0)+,R1 ;GET THE OVERLAY NUMBER ASL R1 ;WORD INDEX MOV #OVLAY,R2 SUB #BEG,R2 CMP R2,SIZLST(R1) BHIS ERR ASR R1 BNE INIT01 ;SKIP IF NOT FIRST OVERLAY MOVB (R0)+,Rl12 ;NO JMP FMT000 ;YES FORM10: MOV R2,R4 FORM13: JSR PC,TSTIT JSR PC,OUTCHR ;OUTPUT A CHARACTER MOVB (R1)+,R4 ;GET NEXT CHARACTER BEQ BADLGT ;ERROR IF NO CLOSING ' CMPB #'',R4 ;IS IT A STRING END? BNE FORM13 ;NO MOV R4,R2 JMP FMT013 BADSTR: TRAP+75. ;BAD COUNT BADST: JMP FMT000 BADLGT: DEC R1 ;BACK UP POINTER TRAP+76. ;WEIRD COUN( BR BADST TSTIT: DEC R5 ;DECREMENT CHARACTER COUNT TSTIT1: BGT TST01 ;EXIT IF STILL ROOM MOV R4,-(mC05 ;NO ADD #100000,@SP ;SET NEGATIVE SIGN GC05: MOV R2,-(SP) ;SAVE FIRST MOV R3,-(SP) ;VALUE TOO MOV SP,R0 ;GET ADDRESS OF VARIABLE MOV #10,R4 ;GET LENGTH OF CONSTANT MOV #24000,R5 ;MODE IS COMPLEX .GLOBL SYMCON JSR PC,SYMCON ;DOES CONSTANT ALREADY EXIST? BVC GCMP01 ;YES, DON'T ENTER IT MOV SP,R2 ;REMEMBER ADDRESS OF CONSTANT MOV #8.,R0 ;CLEAR EIGHT GC01: CLR -(SP) ;ENTRIES DEC R0 BNE GC01 MOV SP,R2 ;GET ADDRESS OF SCRATCH .GLOBL DDDD MOV DDDD,R3 ;GET A SERIAL TO Un2 ;GET MAX OVERLAY NUMBER MOV #8.,-(SP) ;MAKE ROOM FOR FIRST SEGMENT MOV #OVTAB,R5 ;GET WORKING ROOM MOV #SIZLST,R0 ;GET ADDRESS OF MAX SIZE TABLE INIT02: MOV (R0)+,R3 ;GET MAX LENGTH OF EACH OVERLAY MOV (SP),(R5)+ ;SAVE SEGMENT ADDRESS ADD #4,R5 ;SKIP OVER UNNEEDED ENTRIES MOV #128.,R4 ;GET SEGMENT SIZE JSR PC,DIVX ;DIVIDE BY SEGMENT SIZE ADD #7,R3 ;ROUND UP TO 8 SEGMENT BIC #7,R3 ;BOUNDARY ADD R3,@SP ;ACCUMULATE TOTAL DEC R2 ;LOOP BPL INIT02 ;UNTIL COMPLETE MOV (SP)+,R4o .TITLE GOTO .IDENT /0711/ ;RFB,PJK,RG ; ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; THIS MODULE CONTAINS - GOTO, ASSIGN ; ; THE GOTO STATEMENTS ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .NLIST BEX .GLOBL PUTNAM,BITM,MISC,OUTGL,OUTNAM,OUTCOM .GLOBL OUTCH2,OUTLN2,OUTTAB .GLOBL OUTSL .GLOBL DIMWD,DIMMKM,ASGWD,ASpSP) ;R4 IS SAFE JSR R5,OUTLN2 ;OUTPUT THE TERMINATOR FMT005 JSR R5,OUTLN2 ;OUTPUT THE .ASCII FMT004 ADD #40.,R5 ;RESTORE COUNT MOV (SP)+,R4 ;RESTORE R4 TST01: RTS PC ;AND RETURN OUTNUM: MOV (SP)+,R2 ;SAVE RETURN ADDRESS MOV (SP)+,R4 ;GET OLD CHARACTER POINTER MOV R2,-(SP) ;RESTORE RETURN ADDRESS MOV R1,R2 ;SAVE INPUT POINTER SUB R4,R1 ;CHARACTER COUNT SUB R1,R5 ;CHECK FOR JSR PC,TSTIT1 ;OUTPUT STRING OVERFLOW MOV R5,-(SP) ;SAVE R5 MOV R1,R5 ;PUT CHARACTER COUNT IN RqSE INC DDDD .GLOBL OTOA JSR PC,OTOA ;CONVERT TO ASCII MOV #"$C,@SP ;MAKE A NAME FOR IT MOV SP,R0 ;ADDRESS OF DESTINATION MOV R1,-(SP) ;SAVE R1 MOV R0,R1 ;ADDRESS OF SCRATCH TO R1 ADD #6,R0 ;TO R0 .GLOBL PACK00 JSR PC,PACK00 ;CONVERT TO RADIX 50 MOV (SP)+,R1 ;RESTORE R1 ADD #6,SP ;GET RID OF SCRATCH CLR -(SP) ;PUT IN NULL ENTRY .GLOBL SERIAL MOV SERIAL,-(SP) ;GET A SERIAL NUMBER FOR IT INC SERIAL ;ADVANCE SERIAL NUMBER .GLOBL CONMKM MOV #024000+CONMKM+10,-(SP) ;TEr ;GET NUMBER OF SEGMENTS TO ADDRESS MOV R4,LENGTH ;REMEMBER THE NEEDED FILE LENGTH .ALLOC #TLB,#FB0,R4 ;ALLOCATE THE PROPER FILE LENGTH TST (SP)+ ;TEST RETURN CODE BMI INIT01 ;-1 IS SUCCESS RETURN CLR -(SP) ;ANYTHING ELSE IS AN ERROR MOV #1400+240,-(SP) ;F240 IOT ; DOES NOT RETURN ; INIT01: .LOOK #TLB,#FB0,1 ;LOOK UP THE FILE LOCATION MOV (SP)+,TBLK ;GET FILE START ADDRESS ;VERIFY THAT FILE EXITS AND IS CONTIGUOUS TST (SP)+ ;DISCARD BIT #200,@SP ;FILE EXITS? BEQ ERR ;BR => NO: sGMKM .GLOBL CHTEST,CURSYM,OUTST,PARXMK,SERMK .GLOBL GENLAB,ZLEQLS .GLOBL PARMKM,PARXMK,OUTOCT,PARWD,SERWD .GLOBL PARXWD .GLOBL CNXC,OUTCHR,EOL,OUTSER .GLOBL GOTO,ASSIGN,GET,CNXC1,PSHWD,PSHMKM ;ENTER HERE FOR ALL GOTO STATEMENTS GOTO: .GLOBL GOFLG JSR PC,CNXC ;FIND NEXT NON-BLANK BEQ GOTOER ;ERROR:END-OF-LINE JSR PC,ZLEQLS ;LOOK FOR ZERO LEVEL = BCC GOTO03 ;BR => NOT THERE SEV ;TRY AS ASSIGNMENT INSTEAD RTS PC ; GOTO03: JSR PC,GENLAB ;HANDLE THE LABEL NOW CMPB #'(,@R1t5 MOV R2,R1 ;SET UP NEW STRING POINTER JSR PC,OUTLN ;OUTPUT THE STRING MOV (SP)+,R5 ;RESTORE R5 RTS PC ;AND RETURN TO CALLER ; D2B - DECIMAL ASCII TO BINARY ; ; CONVERT DECIMAL ASCII STRING TO POSITIVE 15-BIT BINARY ; NUMBER. ; ; V-BIT SET IFF OVERFLOW OCCURS. ; SCAN CONTINUES UNTIL FIRST NON-DIGIT OCCURS. ; ; REGISTER USAGE ; INPUT - R1 IS INPUT STRING POINTER ; OUTPUT - R0 IS BINARY VALUE ; R1 IS UPDATED STRING POINTER ; MODIFY - R0,R1,R2,R4 ; D2B: CLR R2uLL WHAT KIND IT IS MOV SP,R0 ;GET ADDRESS OF ENTRY MOV SP,R2 ;AND ADDRESS ADD #20,R2 ; OF THE CONSTANT VALUE .GLOBL PUTSYM JSR PC,PUTSYM ;PUT IN SYMBOL TABLE ADD #20,SP ;GET RID OF ENTRY GCMP01: MOV CURSYM,R2 ;SET UP JSR PC,GETRTR ;RETURN ARGUMENTS .GLOBL GETRTR ;CORRECTLY ADD #10,SP ;GET RID OF THE CONSTANT MOV (SP)+,R5 ;RESTORE THE MOV (SP)+,R4 ;REGISTERS TST (SP)+ ;DISCARD OLD R1 CLC CLV RTS PC ; ;ERROR RETURNES ; GCMP91: ADD #6,SP ;POP JUNK MOVB (SP)+,NOCvERROR BIT #100,(SP)+ ;CONTIGUOUS? BNE OK ;BR=> YES: OKAY ;FATAL ERROR REPORT ERR: CLR -(SP) MOV #1400+300,-(SP) ;F300 IOT ;DOES NOT RETURN ; OK: TST R1 ;IS THIS THE FIRST TIME THROUGH?? BEQ INIT05 ;YES MOV #4,TBLK+6 ;SET READ FUNCTION MOV #RDCNTX,TBLK+4 ;SET NUMBER OF WORDS MOV #LENGTH,TBLK+2 ;SET ADDRESS .TRAN #TLB,#TBLK ;READ IN THE CONTROL BLOCK .WAIT #TLB MOV #2,TBLK+6 ;RESET TO WRITE FUNCTION INIT05: ASL R1 ;MULTIPLY MOV R1,R0 ;OVERLAY NUMBER ASL R0 ;BY ADD R1,w BEQ GOTOX ;HAVE COMPUTED GOTO INCB GOFLG JSR PC,CHTEST ;CHECK CHAR TYPE BMI GOTOU ;DIGIT => UNCONDITIONAL BVC GOTOER ;ERROR - NOT VALID GOTO JMP GOTOA ;ASSIGNED GOTO ; ; UNCONDITIONAL GOTO ; GOTOU: MOV R1,-(SP) ;REMEMBER BEGINNING OF LABEL JSR PC,SKPSL ;SKIP PAST LABEL BNE GOTOES ;SHOULD BE EOL MOV (SP)+,R1 ;LINE OKAY - RECOVER LABEL POINTER ; GENERATE THE TRANSFER CODE MOV #GOTOT0,R4 ;"$TR,." JSR PC,PUTNAM BITB BITM+4,MISC ;WAS A GLOBL PREV. GENERATED? BNE Gx CLR R0 1$: MOVB (R1)+,R4 BIC #177600,R4 SUB #60,R4 CMP R4,#11 BHI 4$ CMP R0,#6314 BHI 3$ BLO 2$ CMPB R4,#7 BHI 3$ 2$: ASL R0 ADD R0,R4 ASL R0 ASL R0 ADD R4,R0 BR 1$ 3$: INC R2 BR 1$ 4$: DEC R1 TST R2 BEQ 5$ CLR R0 SEV 5$: RTS PC ; ; FORMAT EXPRESSION ; FMTEXP: JSR PC,CNXC ;SKIP BLANKS CMPB #'>,@R1 ;LOOK FOR NULL EXPRESSION BNE 3$ ;BR IF NOT NULL TRAP+144. ;NULL FORMAT EXPRESSION INC R1 ;IGNORE THE <> yNSV MOV (SP)+,R1 ;RESTORE TEXT POINTER 263 ;SET CARRY AND OVERFLOW RTS PC ;AND RETURN GCMP90: TST (SP)+ ;DISCARD SIGN POINTER MOVB (SP)+,NOCNSV GCMP92: MOV (SP)+,R1 SEV ;ERROR RETURN CLC ;TELL HIM IT WASN'T COMPLEX ANYWAY RTS PC .END zR0 ;SIX ADD #OVTAB,R0 ;GET WORKING ADDRESS MOV (R0)+,R2 ;GET START SEGMENT CMP BLKSIZ,#256. ;IS THIS A BIG BLOCK? BEQ INIT08 ;BR => 256. BMI INIT06 ;BR => 64. ASR R2 ;THIS IS 512. INIT08: ASR R2 ;YES, CONVERT ASR R2 ;TO BLOCK ADDRESS INIT06: ADD R2,TBLK ;GET ACTUAL DISK ADDRESS MOV #BEG,(R0) ;SAVE THE CORE START ADDRESS CMP (R0),LOWCOR ;IS THIS THE LOWEST ADDRESS YET? BHIS INIT07 ;NO MOV (R0),LOWCOR ;YES INIT07: MOV (R0),TBLK+2 ;PUT IT IN THE TRAN BLOCK ALSO MOV #OVLAY,R1 ;{OTOU1 ;YES BISB BITM+4,MISC ;NO, SET GENERATED FLAG JSR PC,OUTGL ;GENERATE THE GLOBAL JSR PC,EOL GOTOU1: JSR PC,OUTNAM ;GENERATE THE CALL JSR R5,OUTLN2 ;OUTPUT LINE TERMINATOR GOTOTX ;NOW PUT OUT THE NUMBER, CHECK AS WE GO JSR PC,OUTSL ;OUTPUT STATEMENT LABEL FROM SOURCE BVS GOTOER ;SOME ERROR BR GOTONE ;NORMAL EXIT - ALL OKAY! ; ; ERROR EXITS FOR GOTO ; GOTOET: TST (SP)+ ;POP TWO WORDS GOTOES: TST (SP)+ ;POP ONE WORD GOTOER: TRAP+52. |PAIR JMP FMT000 ;BACK TO MAIN SCAN ; ; HANDLE EXPRESSION ; 3$: MOV R3,-(SP) ;SAVE PAREN COUNT MOV R2,R4 ;OUTPUT THE < JSR PC,OUTCHR JSR R5,OUTLN2 +FMT005 ;CLOSE OUT CURRENT TEXT JSR R5,OUTLN2 +FMT003 ;.EVEN JSR PC,SUBEXP ;PARSE EXPRESSION BIC #70000,2(SP) ;FORCE MODE TO INTEGER BIS #20000,2(SP) MOV R0,-(SP) ;NOTE FOR CLEANUP JSR PC,EXPGEN ;GENERATE CODE MOV @SP,SP ;CLEAR POLISH STACK TST (SP)+ ;PART OF CLEAR STEP JSR R5,OUTLN2 +FMT020 ;RETURN TO FORMAT AT RUN T~GET HIGH ADDRESS SUB (R0)+,R1 ;GET LENGTH IN BYTES ASR R1 ;CONVERT IT TO WORDS MOV R1,(R0)+ ;SAVE IT MOV R1,TBLK+4 ;SAVE IT ALSO IN THE TRAN BLOCK .TRAN #TLB,#TBLK ;WRITE OUT THE DATA .WAIT #TLB SUB R2,TBLK ;POINT TO BLOCK ZERO FO THE FILE MOV #LENGTH,TBLK+2 ;GET ADDRESS OF CONTROL BLOCK MOV #RDCNTX,TBLK+4 ;AND ITS LENGTH .TRAN #TLB,#TBLK ;WRITE OUT THE CONTROL BLOCK .WAIT #TLB .EXIT ; ; DIVIDE R3 BY R4 ; .GLOBL DIVX DIVX: MOV R5,-(SP) ;SAVE R5 CLR R5 ;PRE-CLEAR RESULT  ;"ILLEGAL SYNTAX" ; ; NORMAL EXIT FROM THIS MODULE ; GOTONE: JSR PC,EOL ;START HERE FOR NORMAL EXIT CLV ;DON'T TRY ASSIGNMENT RTS PC ; ; SOME TEXT FOR THESE GOTOES ; ; SYMBOLIC NAMES OF ASCII CONTROL CHARACTERS TAB=11 ;HORIZONTAL TAB LF=12 ;LINE FEED CR=15 ;CARRIAGE RETURN GOTOT0: .BYTE TAB .ASCII "$TR" .BYTE 0 GOTOTX: .BYTE 15,12,TAB,'. .BYTE 0 ; GOTOT3: .BYTE TAB .ASCII "$TRX" .BYTE 0 GOTOT4: .BYTE TAB .ASCII "." IME JSR R5,OUTLN2 +FMT004 ;.ASCII ... JSR PC,CNXC CMPB #'>,@R1 ;GOOD TERMINATOR? BEQ 1$ ;BR IF YES TRAP+143. ;MISSING > OR EXPRESSION ERROR BR 2$ 1$: INC R1 ;SKIP > 2$: MOV #40.,R5 ;RETURN TO MAIN SCAN MOV (SP)+,R3 JSR PC,CNXC ;DON'T ALLOW WITH HOLLERITH CMPB #'H,@R1 BNE 4$ ;BR IF OKAY TRAP+145. INC R1 4$: JMP FMT000 .NLIST BEX FMT020: .ASCII / .GLOBL $FMTRT/<15><12> .ASCII / $FMTRT/<15><12><0> FMT001: .ASCII / $TR/ .BYT .TITLE HDRGEN ; ; COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL OTOA,CKOP,SCAN2A,GENLAB,OUTLN2,SEQSUP R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 SPACE=40 ; HDR1: .ASCII / .TITLE / .BYTE 0 HDR2: .ASCII / .CSECT/ .BYTE 15,12 HDR2L = .-HDR2 HDR3: .ASCII / .GLOBL / .BYTE 0 HDR5: .ASCII /: JSR %4,$POLSH/ .BY TST R3 ;IS VALUE ZERO? BEQ D2 ;YES D1: INC R5 ;INCREMENT RESULT SUB R4,R3 ;SUBTRACT BGT D1 ;UNTIL .LE. ZERO MOV R5,R3 ;PLACE RESULT IN R3 D2: MOV (SP)+,R5 RTS PC ;AND RETURN ; BLKSIZ: 0 ; TBLK: 0 ;START BLOCK 0 ;START CORE ADDRESS 0 ;WORD COUNT 2+.-. ;WRITE 0 ;RESERVED ; .END INIT .BYTE 0 GOTOT5: .BYTE TAB .ASCII "$TRA" .BYTE 0 GOTOT6: .BYTE TAB,'0,CR,LF,0 GOTOT7: .BYTE TAB .ASCII '$TRAL' .BYTE 0 .EVEN ; ; COMPUTED GOTO ; GOTOX: INC R1 ;ADVANCE R1 PAST ( CLR R0 ;WILL COUNT THE NUMBER OF LABELS IN R0 MOV R1,-(SP) ;SAVE CURRENT R1 GOTOX1: JSR PC,SKPSL ;SKIP LABEL INC R0 ;COUNT MOVB (R1)+,R2 CMPB R2,#', BEQ GOTOX1 ;MORE LABELS TO COME CMPB R2,#') BNE GOTOES ;") MISSING" ;R0 NOW HAS NUMBER OF LABELSE 0 FMT004: .ASCII / .ASCII ^/ .BYTE 0 FMT005: .ASCII /^/ .BYTE 15,12,0 FMT003: .ASCII / .EVEN/ .BYTE 15,12,0 CLIST: .BYTE '(,'),'','.,',,'/,'-,'<,'A .BYTE '0,'9,'D,'E,'F,'G,'I,'O,'L .EVEN .END TE 15,12 .ASCII / .GLOBL $POLSH,$NAM/ .BYTE 15,12 .ASCII / $NAM,0,0,/ .BYTE 0 HDR4: .ASCII / .GLOBL $SEQ/ .BYTE 15,12,0 .EVEN ; .GLOBL HDRGEN,HDR,OUTLN2,SYM1WD,OUTST,EOL .GLOBL HEAD,HLGT,OUTLN,HDR2,HDR2L,BLKDAT .GLOBL OUTOCT,OUTCH2 ; ; HDRGEN - HEADER GENERATOR AND PROTOTYPES. UPON ENTRY ; R0 POINTS TO HEADER NAME. ; REGISTERS CHANGED - R1,R4,R5. ; HDRGEN: INC HDR ;SET HEADER GENERATED FLAG JSR R5,OUTLN2 ;OUTPUT THE NAME HDR1 SUB # GOTOX2: MOV R0,-(SP) ;SAVE FOR NOW JSR PC,CNXC ;SKIP OPTIONAL, CMPB #',,@R1 BNE GOTOX3 INC R1 ;NOW GET VARIABLE NAME GOTOX3: JSR PC,GETLBV ;GET INDEX VARIABLE BVS GOTOET ;GET ERROR => PUNT TSTB @R1 ;THAT SHOULD BE ALL:EOL EXPECTED BNE GOTOET ;NOT SO => ERROR JSR PC,GOVAL ;GENCODE VALUE TO STACK MOV #GOTOT3,R4 ;GENCODE INVOKE SERVICER JSR PC,PUTNAM ;$TRX BITB BITM+5,MISC ;WAS A $TRX GLOBAL PREV. GEN.?? BNE GOTOX4 ;YES BISB BITM+5,MISC ;NO JSR PC,OUTGL ;GENERATSYM1WD,R0 JSR PC,OUTST JSR PC,EOL MOV #HEAD,R4 MOV #HLGT,R5 JSR PC,OUTLN MOV #HDR2,R4 ;OUTPUT THE MOV #HDR2L,R5 ;REMAINDER JSR PC,OUTLN ;OF HEADER TST BLKDAT ;BLOCK DATA? BNE HDRE1 ;YES, SKIP REST OF FORMALITIES!! JSR R5,OUTLN2 HDR3 JSR PC,OUTST ;NAME JSR PC,EOL JSR PC,OUTST ;NAME AGAIN JSR R5,OUTLN2 HDR5 ADD #SYM1WD,R0 MOV (R0)+,R3 ;GET FIRST WORD OF NAME JSR PC,OUTOCT ;OUTPUT IT JSR R5,OUTCH2 ', MOV (R0)+,R3 ;OUTPUT JSR PC,OUTOCT ;SECOND WORD JSR PC,EO .TITLE HEAD00 .IDENT /0506/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; ;THIS ROUTINE CONTAINS ALL THE INFORMATION REQUIRED ; TO LINK TOGETHER AND INTERCONNECT THE VARIOUS ; OVERLAYS. THE FIRST WORD CONTAINS THE OVERLAY ; NUMBER OF THIS ROUTINE. ; .GLOBL OVLIST BEG: OVLIST: .BYTE 0,4 ;OVERLAY 0, MAX OVERLAY 4 DESCR ;ADDRESS OF DESCRIPTION LIST TRNVEC ;ADDRESS OF TRANSFER VECTOR ;OVERLAY 0 TRANSFER VECTORS ; .GLOBL END,ENDPRO,SYN3ER,TFUN E THE GLOBAL JSR PC,EOL GOTOX4: JSR PC,OUTNAM ;GENERATE THE NAME JSR PC,OUTCOM ;OUTPUT A COMMA MOV (SP)+,R3 ;THE LABEL COUNT NEXT OUT JSR PC,OUTOCT JSR PC,EOL ;CLOSE THE LINE MOV (SP)+,R1 ;BEGINNING OF LABEL LIST JSR PC,GOLABS ;OUTPUT THE LABEL LIST JMP GOTONE ;GETTING HERE MEANS SUCCESS! ; GOVAL ; ; GENCODE TO GET VALUE TO STACK FOR USE ; BY GOTO SERVICERS. CHECKS ARE MADE TO ; VERIFY VARIABLE IS NOT DIMENSIONED AND ; IS AN INTEGE .TITLE HEAD01 .IDENT /0506/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ;THIS ROUTINE CONTAINS ALL THE INFORMATION REQUIRED ; TO LINK TOGETHER AND INTERCONNECT THE VARIOUS ; OVERLAYS. THE FIRST WORD CONTAINS THE OVERLAY ; NUMBER OF THIS ROUTINE. ; .GLOBL OVLIST BEG: OVLIST: .BYTE 1,4 ;OVERLAY 1, MAX OVERLAY 4 DESCR ;ADDRESS OF DESCRIPTION LIST TRNVEC ;ADDRESS OF TRANSFER VECTOR ; ;DUMMY ENTRY TO REMOVE LINKER ERROR ; .GLOBL RSET RSET: ; L TSTB SEQSUP ;SUPPRESS SEQUENCING? BNE HDRE1 ;YES JSR R5,OUTLN2 ;OUTPUT HDR4 ; EXTRA GLOBL HDRE1: RTS PC .END ; ; GENERATE STATEMENT LABEL FOR EXECUTABLE STATEMENT ; GENLAB: TST INHLAB ;IS THE LABEL NEEDED OR DESIRED? BNE LABEZ ;NOT AT ALL MOV R3,-(SP) MOV R4,-(SP) MOV #LINENO,R4 ;GET ADDRESS OF LINE NUMBER TSTB @R4 ;IS THERE A LINE NUMBER BEQ LABEX ;NO JSR R5,OUTCH2 ;OUTPUT A . '. JSR R5,OUTLN2 ;AND A LINE NUMBER LINENO  .GLOBL BACKSP,REWIND,ENDFIL TRNVEC: END ENDPRO SYN3ER TFUN BACKSP REWIND ENDFIL ; .GLOBL DESCR,DISP,JLIST ; DESCR: ; ;SCANNR .BYTE 6,0,0 ;OVERLAY 1, ENTRY 0, NO RETURN ;RETURN .BYTE 14,4,1 ;OVERLAY 2, ENTRY 2, RETURN ;PALFTN .BYTE 30,0,1 ;OVERLAY 4, ENTRY 0, RETURN ;ALOCAT .BYTE 6,2,1 ; .EVEN .GLOBL SCANNR,RETURN,PALFTN,ALOCAT ALOCAT: INC DISP PALFTN: INC DISP RETURN: INC DISP SCANNR: JMP JLIST ;GOTO OVERLAY HANDLER ; . = BEG+240 ; .END R TYPE. ; ; INPUT: CURSYM POINTS TO STE (SET UP BY GETLBV) ; OUTPUT: TO OBJECT DEVICE - CODE TO MOVE VALUE TO STACK ; REGISTERS CHANGED: R0,R2,R3,R4,R5 ; ;TWO CASES: A PARAMETER OR NOT GOVAL: MOV CURSYM,R0 GONOP: JSR PC,OUTTAB MOV CURSYM,R0 BIS #PSHMKM,PSHWD(R0) ;SET PUSH FLAG MOV SERWD(R0),R3 BIC #SERMK,R3 MOV #'P,R0 JSR PC,OUTSER JSR PC,EOL RTS PC ; ; OUTPUT THE LABELS ; GOLABS: JSR R5,OUTLN2 GOTOT4 JSR PC,OUTSL ;OUTPUT LABEL GOTERR: BVS GOTOER ;A LABEL ERROR ;OVERLAY 1 TRANSFER VECTORS ; .GLOBL SCANNR,ALOCAT TRNVEC: SCANNR ALOCAT ; ;OVERLAY 1 JUMP LIST ; ;NULL FOR NOW ; ;OVERLAY 1 INTERNAL DISPATCH TABLE ; .GLOBL NEXJMP,BJMP,SUBROU,FUNCTI,BLOCKD .GLOBL EXTERN,DEFINE,DIMENS,COMMON .GLOBL EQUIVA,DATA,SCAN18,END ; NEXJMP: SUBROU FUNCTI BLOCKD EXTERN DEFINE BJMP: DIMENS COMMON EQUIVA DATA SCAN18 ;SPECIAL HANDLING FOR "IMPLICIT" END ; .GLOBL DESCR,DISP,JLIST ; DESCR: ; ;SYN3ER .BYTE 0,4,1 ;OVERLAY 0, ENTRY 2, RETURN MOV #TERM,R4 ;GET TERMINATOR LABEY: JSR PC,OUTLN1 ;OUTPUT IT MOV SEQNO,R3 JSR PC,OUTOCT JSR PC,EOL MOV (SP)+,R4 MOV (SP)+,R3 LABEZ: RTS PC TERM: .ASCII /: $SEQ,/ .BYTE 0 .EVEN LABEX: MOV #TERM+1,R4 BR LABEY ; ; HDRGEN - HEADER GENERATOR AND PROTOTYPES. UPON ENTRY ; R0 POINTS TO HEADER NAME. ; REGISTERS CHANGED - R1,R4,R5. ; HDRGEN: INC HDR ;SET HEADER GENERATED FLAG JSR R5,OUTLN2 ;OUTPUT THE NAME HDR1 SUB #SYM1WD,R0 JSR PC,OUTST JSR PC,EOL MOV #HEAD,R4 MOV #HLGT JSR PC,EOL CMPB #',,(R1)+ BEQ GOLABS ;BACK TO NEXT ONE DEC R1 ;R1 POINTS TO TERMINAL CHAR RTS PC ; ; ASSIGNED GOTO ; GOTOA: JSR PC,GETLBV BVS GOTERR ;REPORT ERROR JSR PC,GOVAL ;GENCODE FOR VALUE MOV CURSYM,R0 BIS #ASGMKM,ASGWD(R0) ;MARK USED IN ASSIGN/GOTO ; ; MUST BE END-OF-LINE OR , TO BE LEGAL ; TSTB @R1 BEQ GOTOA1 ;HAVE EOL CMPB #',,@R1 ;SKIP COMMA BEFORE LIST BNE GOTOEX ;NO COMMA TO SKIP:ERROR JSR PC,CNXC1 ;SKIP TH ;END .BYTE 0,0,1 ;OVERLAY 0, ENTRY 0, RETURN ;ENDPRO .BYTE 0,2,0 ;OVERLAY 0, ENTRY 1, NO RETURN ;EXECUT .BYTE 14,0,0 ;OVERLAY 2, ENTRY 0, NO RETURN ;EXPGEN .BYTE 14,10,1 ;OVERLAY 2, ENTRY 4, RETURN ;SUBEXP .BYTE 14,6,1 ;OVERLAY 2, ENTRY 3, RETURN ; .EVEN .GLOBL SYN3ER,END,ENDPRO,EXECUT,SUBEXP,EXPGEN SUBEXP: INC DISP EXPGEN: INC DISP EXECUT: INC DISP ENDPRO: INC DISP END: INC DISP SYN3ER: JMP JLIST ;GOTO OVERLAY HANDLER . = BEG+240 .END ,R5 JSR PC,OUTLN MOV #HDR2,R4 ;OUTPUT THE MOV #HDR2L,R5 ;REMAINDER JSR PC,OUTLN ;OF HEADER TST BLKDAT ;BLOCK DATA? BNE HDRE1 ;YES, SKIP REST OF FORMALITIES!! JSR R5,OUTLN2 HDR3 JSR PC,OUTST ;NAME JSR PC,EOL JSR PC,OUTST ;NAME AGAIN JSR R5,OUTLN2 HDR5 ADD #SYM1WD,R0 MOV (R0)+,R3 ;GET FIRST WORD OF NAME JSR PC,OUTOCT ;OUTPUT IT JSR R5,OUTCH2 ', MOV (R0)+,R3 ;OUTPUT JSR PC,OUTOCT ;SECOND WORD JSR PC,EOL HDRE1: RTS PC ; ; GENERATE STATEMENT LABEL FOR EXECUTABLE S .TITLE HEAD02 .IDENT /0506/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; ;THIS ROUTINE CONTAINS ALL THE INFORMATION REQUIRED ; TO LINK TOGETHER AND INTERCONNECT THE VARIOUS ; OVERLAYS. THE FIRST WORD CONTAINS THE OVERLAY ; NUMBER OF THIS ROUTINE. ; .MCALL .PARAM .PARAM .GLOBL OVLIST BEG: OVLIST: .BYTE 2,4 ;OVERLAY 2, MAX OVERLAY 4 DESCR ;ADDRESS OF DESCRIPTION LIST TRNVEC ;ADDRESS OF TRANSFER VECTOR ; ;DISPATCH ROUTINES FOR EXECUTABLESE COMMA GOTOA3: CMPB #'(,@R1 ;LOOK FOR LABEL LIST BEQ GOTOA2 ;BR => LOOKS GOOD SOFAR BR GOTOEX ;ERR0R - NO ( FOR LABEL LIST ; ; ASSIGNED GOTO WITH CHECK LIST ; GOTOA2: INC R1 ;SKIP OVER THE ( MOV #GOTOT7,R4 JSR PC,PUTNAM BITB BITM+6,MISC BNE GOTOA4 BISB BITM+6,MISC ;SET GLOBAL FLAG JSR PC,OUTGL ;GENERATE THE GLOBAL JSR PC,EOL GOTOA4: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,EOL JSR PC,GOLABS ;OUTPUT THE LABEL LIST CMPB #'),@R1 ;MUST CLOSE WITH ) BNE GOTOEX ;ERROR - NO TATEMENT ; GENLAB: TST INHLAB ;IS THE LABEL NEEDED OR DESIRED? BNE LABEZ ;NOT AT ALL MOV R3,-(SP) MOV R4,-(SP) MOV #LINENO,R4 ;GET ADDRESS OF LINE NUMBER TSTB @R4 ;IS THERE A LINE NUMBER BEQ LABEX ;NO JSR R5,OUTCH2 ;OUTPUT A . '. JSR R5,OUTLN2 ;AND A LINE NUMBER LINENO MOV #TERM,R4 ;GET TERMINATOR LABEY: JSR PC,OUTLN1 ;OUTPUT IT MOV SEQNO,R3 JSR PC,OUTOCT JSR PC,EOL MOV (SP)+,R4 MOV (SP)+,R3 LABEZ: RTS PC TERM: .ASCII /: $SEQ,/ .BYTE 0 .EVEN LABEX: MOV #TERM+1 AND LOGICAL 'IF' ; .GLOBL EXDSP,EXRET,IFDSP,IFRET EXDSP: JSR PC,@EXJMP(R0) ;DISPATCH TO EXECUTABLE JMP EXRET ;RETURN TO MODULE 'EXECUT' IFDSP: JSR PC,@IFJMP(R0) ;DISPATCH TO LOGICAL 'IF' SUBSTATEMENT JMP IFRET ;RETURN TO MODULE 'IF' ; ;DUMMY ENTRY TO REMOVE LINKER ERROR ; .GLOBL RSET RSET: ; ;OVERLAY 2 TRANSFER VECTORS ; .GLOBL EXECUT,RETURN,SUBEXP,EXPGEN,OVJMP,ASGN TRNVEC: EXECUT ENDFIL RETURN SUBEXP EXPGEN OVJMP ASGN ; ;OVERLAY 2 JUMP LIST ; ;NULL FOR NOW ;) JSR R5,OUTLN2 GOTOT6 JMP GOTONE ;ALL EXIT HAPPY ; ; ASSIGNED GOTO WITHOUT CHECK LIST ; GOTOA1: MOV #GOTOT5,R4 JSR PC,PUTNAM BITB BITM+7,MISC ;CHECK FOR GLOBAL NEEDED BNE GOTOA5 ;NOT NEEDED BISB BITM+7,MISC ;SET FOUND FLAG JSR PC,OUTGL ;GELERATE THE GLOBAL JSR PC,EOL GOTOA5: JSR PC,OUTNAM ;GENERATE THE NAME JSR PC,EOL JMP GOTONE ;NORMAL EXIT ; ; A LONG LINK TO THE ERROR REPORTERS ; GOTOEX: JMP GOTOER ; ; SKIP OVER A STATEME .TITLE HEAD03 .IDENT /0506/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; ;THIS ROUTINE CONTAINS ALL THE INFORMATION REQUIRED ; TO LINK TOGETHER AND INTERCONNECT THE VARIOUS ; OVERLAYS. THE FIRST WORD CONTAINS THE OVERLAY ; NUMBER OF THIS ROUTINE. ; .MCALL .PARAM .PARAM .GLOBL OVLIST BEG: OVLIST: .BYTE 3,4 ;OVERLAY 3, MAX OVERLAY 4 DESCR ;ADDRESS OF DESCRIPTION LIST TRNVEC ;ADDRESS OF TRANSFER VECTOR ; ;DISPATCH ROUTINES FOR EXECUTABLES,R4 BR LABEY ; ; HDRGEN - HEADER GENERATOR AND PROTOTYPES. UPON ENTRY ; R0 POINTS TO HEADER NAME. ; REGISTERS CHANGED - R1,R4,R5. ; HDRGEN: INC HDR ;SET HEADER GENERATED FLAG JSR R5,OUTLN2 ;OUTPUT THE NAME HDR1 SUB #SYM1WD,R0 JSR PC,OUTST JSR PC,EOL MOV #HEAD,R4 MOV #HLGT,R5 JSR PC,OUTLN MOV #HDR2,R4 ;OUTPUT THE MOV #HDR2L,R5 ;REMAINDER JSR PC,OUTLN ;OF HEADER TST BLKDAT ;BLOCK DATA? BNE HDRE1 ;YES, SKIP REST OF FORMALITIES!! JSR R5,OUTLN2 HDR3 JSR PC,OUTST ;NAM ;OVERLAY 2 INTERNAL DISPATCH LIST ; .GLOBL END,DO .GLOBL CALL,CONTIN,RETURN,IF,READ,PRINT,WRITE .GLOBL FIND,ENCODE,DECODE ; EXJMP: END OV3JMP DO OV3JMP IFJMP: OV3JMP CALL CONTIN RETURN OV3JMP IF OV3JMP OV3JMP READ PRINT WRITE ENCODE DECODE REWIND BACKSP FIND ; .GLOBL DESCR,DISP,JLIST ; DESCR: ; ;SCANNR .BYTE 6,0,0 ;OVERLAY 1, ENTRY 0, NO RETURN ;SYN3ER .BYTE 0,4,1 ;OVERLAY 0,ENTRY 2, RETURN ;END .BYTE 0,0,1 ;OVERLAY 0, ENTRY 0, RETURN ;ALOCATNT LABEL ; SKPSL1: INC R1 ;LOOP LOCATION SKPSL: JSR PC,CNXC ;ENTRY POINT LOCATION JSR PC,CHTEST BMI SKPSL1 ;DIGIT => KEEP SCANNING TSTB @R1 ;ELSE RETURN-SET STATUS RTS PC ;FOR ZERO TEST AFTER RETURN ; ; GETLBV ; ;GET LABEL VARIABLE GETLBV: JSR PC,GET BVS GETLV9 CMP #2,R2 ;MUST BE AN INTEGER BNE GETLV9 ;NO => ERROR TST R3 ;MUST BE A VARIABLE BNE GETLV9 ;NO => ERROR MOV CURSYM,R3 BIT DIMWD(R3),#DIMMKM ;NOT DIMENSIONED? BNE GETLV9 ;BR => ERROR JSR PC,CNXC ;SET U AND LOGICAL 'IF' ; .GLOBL EXDSP,IFDSP,EXRET,IFRET EXDSP: JSR PC,@EXJMP(R0) ;DISPATCH TO EXECUTABLE JMP EXRET ;RETURN TO MODULE 'EXECUT' IFDSP: JSR PC,@IFJMP(R0) ;DISPATCH TO LOGICAL 'IF' SUBSTATEMENT JMP IFRET ;RETURN TO MODULE 'IF' ; ;DUMMY ENTRIES TO REMOVE LINKER ERROR ; .GLOBL RSET,ASGN8,ASGN9,CALL03,CALL05 .GLOBL LIST99 ASGN8:ASGN9:CALL03:CALL05: LIST99:RSET: ; ;OVERLAY 2 TRANSFER VECTORS ; .GLOBL OVJMP TRNVEC: OVJMP ; ;OVERLAY 2 JUMP LIST ; ;NULL FOR NOW ; ;OVEE JSR PC,EOL JSR PC,OUTST ;NAME AGAIN JSR R5,OUTLN2 HDR5 ADD #SYM1WD,R0 MOV (R0)+,R3 ;GET FIRST WORD OF NAME JSR PC,OUTOCT ;OUTPUT IT JSR R5,OUTCH2 ', MOV (R0)+,R3 ;OUTPUT JSR PC,OUTOCT ;SECOND WORD JSR PC,EOL HDRE1: RTS PC  .BYTE 6,2,1 ;OVERLAY 1, ENTRY 1, RETURN ;ENDPRO .BYTE 0,2,0 ;OVERLAY 0, ENTRY 1, NO RETURN ;TFUN .BYTE 0,6,1 ;OVERLAY 0, ENTRY 3, RETURN ;ENDFIL .BYTE 0,14,1 ;OVERLAY 0, ENTRY 6, RETURN ;OV3JMP .BYTE 22,0,0 ;OVERLAY 3, ENTRY 0, NO RETURN ;REWIND .BYTE 0,12,1 ;OVERLAY 0, ENTRY 5, RETURN ;BACKSP .BYTE 0,10,1 ;OVERLAY 0, ENTRY 4, RETURN ; .EVEN .GLOBL SCANNR,SYN3ER,END,ALOCAT,ENDPRO,TFUN .GLOBL ENDFIL BACKSP: INC DISP REWIND: INC DISP OV3JMP: INC DISP ENDFIL: INC DISP TFUN: IP R1 FOR NEXT CHAR CLV ;CLEAR ERROR FLAG RTS PC GETLV9: SEV ;SET ERROR FLAG - NOT INTEGER VAR RTS PC ; ;ASSIGN STATEMENT ; ASSIGN: JSR PC,ZLEQLS ;LOOK FOR ZERO LEVEL = BCC ASSI02 ;C CLEAR => NOT FOUND SEV ;FOUND => TRY AS ASSIGNMENT RTS PC ASSI02: JSR PC,GENLAB MOV R1,-(SP) ;SAVE CURRENT R1 JSR PC,SKPSL ;SKIP OVER LABEL JSR PC,CNXC ;LOOK FOR "T0" CMPB #'T,(R1)+ ; BNE ASSIER JSR PC,CNXC CMPB #'O,(R1)+ BEQ ASSI01 ; ; RLAY 2 INTERNAL DISPATCH LIST ; .GLOBL FORMAT,GOTO,PAUSE,STOP .GLOBL DEFINE,IF,ASSIGN ; EXJMP: END FORMAT OV2JMP DEFINE IFJMP: ASSIGN OV2JMP OV2JMP OV2JMP GOTO IF PAUSE STOP OV2JMP OV2JMP OV2JMP OV2JMP OV2JMP REWIND BACKSP OV2JMP ; .GLOBL DESCR,DISP,JLIST ; DESCR: ; ;SCANNR .BYTE 6,0,0 ;OVERLAY 1, ENTRY 0, NO RETURN ;SYN3ER .BYTE 0,4,1 ;OVERLAY 0,ENTRY 2, RETURN ;ALOCAT .BYTE 6,2,1 ;OVERLAY 1, ENTRY 1, RETURN ;OV2JMP .BYTE 14,12,0 ;OVERLAY 2, ENC DISP ENDPRO: INC DISP ALOCAT: INC DISP END: INC DISP SYN3ER: INC DISP SCANNR: JMP JLIST ;GO TO OVERLAY HANDLER . = BEG+240 .END  ERROR IN ASSIGN ; ASSIER: TST (SP)+ ;CLEAR STACK ASSI90: TRAP+52. ASSINE: JSR PC,EOL ;COME HERE FOR NORMAL EXIT CLV RTS PC ;FOUND "T0" OKAY ASSI01: JSR PC,GETLBV ;COLLECT A LABEL VARIABLE BVS ASSIER ;GET ERROR => PUNT TSTB @R1 ;MUST BE ALL BNE ASSIER ; ;THERE REMAIN 2 CASES ; VARIABLE IS A PARAMETER OR NOT ; MOV CURSYM,R0 ;POINTER TO SYMBOL TABLE BIS #ASGMKM,ASGWD(R0) ;MARK USED IN ASSIGN/GOTO BIT PARWD(R0),#PARMKM ;LOOK AT PAR BIT BEQ ASSINP ;BR => NOT PARAMETER NTRY 5, NO RETURN ;TFUN .BYTE 0,6,1 ;OVERLAY 0, ENTRY 3, RETURN ;ASGN .BYTE 14,14,1 ;OVERLAY 2, ENTRY 6, RETURN ;REWIND .BYTE 0,12,1 ;OVERLAY 0, ENTRY 5, RETURN ;BACKSP .BYTE 0,10,1 ;OVERLAY 0, ENTRY 4, RETURN ;ENDPRO .BYTE 0,2,0 ;OVERLAY 0, ENTRY 1, NO RETURN ;END .BYTE 0,0,1 ;OVERLAY 0, ENTRY 0, RETURN ; .EVEN .GLOBL SCANNR,SYN3ER,ALOCAT,TFUN,ASGN,ENDPRO END: INC DISP ENDPRO: INC DISP BACKSP: INC DISP REWIND: INC DISP ASGN: INC DISP TFUN: INC DISP OV2JMP: INC DISP ALOCAT:  .TITLE HEAD04 .IDENT /0610/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; ;THIS ROUTINE CONTAINS ALL THE INFORMATION REQUIRED ; TO LINK TOGETHER AND INTERCONNECT THE VARIOUS ; OVERLAYS. THE FIRST WORD CONTAINS THE OVERLAY ; NUMBER OF THIS ROUTINE. ; .GLOBL OVLIST .PSECT ZZZAAA BEG: OVLIST: .BYTE 4,4 ;OVERLAY 4, MAX OVERLAY 4 DESCR ;ADDRESS OF DESCRIPTION LIST TRNVEC ;ADDRESS OF TRANSFER VECTOR ; ;DUMMY ENTRY TO REMOVE LINKER ERROR ; .GLOB; ; PARAMETER CASE ; MOV #ASSIT0,R4 ;SERVICER MOVB BITM+0,R3 ;GET MASK MOV #ASSIG1,R2 ;COMPLETION OF THIS STATEMENT BR ASSIG3 ; ; NON-PARAMETER CASE ; ASSINP: MOV #ASSIT2,R4 ;SERVICER MOVB BITM+1,R3 ;GET MASK MOV #ASSIG2,R2 ;COMPLETION ; ;COMMON SECTION ; ASSIG3: JSR PC,PUTNAM ;GET THE NAME BITB R3,MISC+1 ;DO VE HAF TO GENERATE GLUBL BNE ASSIG4 ;NINE? BISB R3,MISC+1 ;SET GENERATED FLAG JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL INC DISP SYN3ER: INC DISP SCANNR: JMP JLIST ;GO TO OVERLAY HANDLER . = BEG+240 .END L RSET RSET: ; ;OVERLAY 3 TRANSFER VECTORS ; .GLOBL PALFTN TRNVEC: PALFTN ; .GLOBL DESCR,DISP,JLIST ; DESCR: ; ; .EVEN ; . = BEG+240 ; .END  .TITLE IF .IDENT /0506/ ; ;COPYRIGHT 1971,1973, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY L. COHEN, D. KNIGHT ; ; ;IF PROCESSOR ;IF IDENTIFIED BY "IF(". R1 POINTS BEYOND THE LEFT PAREN. ;UPON ENTRY. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL CNXC1,SUBEXP,SCAN2A,EXPGEN,OUTLN,FLABL,IF,EOL .GLOBL CHTEST,OUTASSIG4: JSR PC,OUTNAM JSR R5,OUTLN2 ASSIT1 MOV (SP)+,R1 ;POP POINTER TO LABEL JSR PC,OUTSL ;GENCODE FOR LABEL BVS ASSI90 ;BR => ERROR JSR PC,EOL ;OUTPUT LINE TERMINATOR JSR R5,OUTCH2 ;AND A TAB ;TAB MOV CURSYM,R0 ;SYMBOL TABLE ENTRY ADDRESS JMP @R2 ;DISPATCH TO COMPLETION ; ; PARAMETER CASE ; ASSIG1: MOV PARXWD(R0),R3 ;PARAM NUMBER BIC #PARXMK,R3 ASL R3 JSR PC,OUTOCT ;PARAMETER INDEX ;ALL DONE SO EXIT BR ASSINE ; ; NON-PARAMETER CASE ; ASSIG2: JSR PC,OUTST ;OUSER,CNXC,OUTLN2 .GLOBL ASGN,IFTAB,SCAN2A,OTOA,GENLAB .GLOBL INHLAB,OUTCHR .GLOBL IFDSP,IFRET ; ; IF011A: JMP IF011 ;INTERMEDIATE HELP ; ; ; ; IF: JSR PC,SUBEXP MOV R2,-(SP) ;SAVE VITAL REGISTERS, 1ST EXP MOV R0,-(SP) JSR PC,CNXC MOV 2(SP),R2 ;RESTORE R2 CMPB (R1),#') ;IF TERM. NOT =")" THIS IS AN ILLEGAL IF BNE IF011A JSR PC,CNXC1 ;IF NEXT CH IS "=" THIS IS ;AN ASSIGNMENT STTEMENT CMPB (R1),#'= BEQ IF011A ;BR IF THIS IS AN ASSIGNMENT STTMNT ;PICK UP MODE OF EXPRESSION TPUT FROM ST BR ASSINE ; ; SOME TEXT FOR ASSIGN ; TAB =11 ASSIT0: .BYTE TAB .ASCII "$ASP" .BYTE 0 ASSIT2: .BYTE TAB .ASCII "$AS" .BYTE 0 ASSIT1: .BYTE 15,12,TAB,'.,0 ;HI THERE, LISTING READER .EVEN .END  .TITLE IMPLIC ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; ;IMPLICIT PROCESSOR - ENTERED WITH MODE IN LOW ORDER R0 ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; .GLOBL IMPLIC,IMPTAB,NXTCH,CHT1,SERIAL,SERATR .GLOBL DOLST ; IMPLIC: ASL R0 ;PLACE TYPE ASL R0 ;IN THE ASL R0 ;C .TITLE INIT ;COMPILER INITIALIZATION .IDENT /0611A/ ;LP ; ;COPYRIGHT 1971, 1972, 1973, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; .MCALL .CLOSE,.CSI1,.CSI2,.DELET,.EXIT,.INIT,.MONF,.PARAM .MCALL .OPEN,.READ,.RLSE,.RSTRT,.TMCVT,.TRAP,.WAIT,.WRITE .MCALL .CORE ; .GLOBL RSET,TTLCNT,OLDHGH,DOLST,DPTR .GLOBL EXIT .GLOBL ALOKAT,BUFIN,CMDBUF,COMCLR .GLOBL COMUN,ECNT,ENDCLR,EQVHED,ERRCUR,ERRS .GLOBL FLABL,GBUF,HEAD1,HLGT1,INHD,INPBLK .GLOBL ITOA,LINKI,LINKK,LINKL,LINKOL,LINKSL .GLO MOV R2,R5 SWAB R5 ;SHIFT TO LOW ORDER OF R5, ASR R5 ;MULTIPLIED BY 2 ASR R5 ASR R5 ASR R5 BIC #177770,R5 ;CLEAR ALL OTHER BITS ;R1 POINTS PAST THE ) JSR PC,CHTEST ;DOES LABEL FOLLOW? BMI IF04 ;THIS IS AN ARITHMETIC IF ; ; LOGICAL IF STATEMENT ; IF041: JSR PC,GENLAB ;GENERATE STATEMENT LABEL IF ANY ;FORCE TYPE OF RESULT TO BE LOGICAL CMP #1,R5 ;MUST BE LOGICAL BEQ 1$ TRAP+141. BIC #070000,6(SP) BIS #010000,6(SP) 1$: JSR PC,EXORRECT POSITION CLR R4 ;CLEAR ENTRIES MADE FLAG IMP01: JSR PC,NXTCH ;GET A NON-BLANK CHARACTER TST R2 ;IS IT ZERO? BEQ IMPEND ;YES , ALL IS DONE CMPB R2,#'( ;DID WE FIND A LEFT PAREN? BNE SINGLE ;NO JSR PC,NXTCH ;GET THE NEXT CHARACTER JSR PC,CHT1 ;IT MUST BE ALPHABETIC BVC ERROR ;IT WASN'T MOV R2,R3 ;SAVE IT JSR PC,NXTCH ;A "-" MUST COME NEXT CMPB R2,#'- ;WAS IT THERE? BNE SINGLF ;NO JSR PC,NXTCH ;TRY FOR ANOTHER ALPHABETIC JSR PC,CHT1 ;GOT IT? BVC ERROR ;NO CBL LSTBLK,LSTER,LSTEXT,OBJBLK,OBJER .GLOBL OBJEXT,OBJLS,OUTPUT,SCANNR,SRCIN .GLOBL SRCLS,STCLR,SYNERR,LOWCOR .GLOBL SYMBAS,SYMEND,SYMCUR .GLOBL SERIAL,SRCERR,SRCEXT,IMPTAB .GLOBL ISW,SEQSUP,TYPSIZ,ARYCHK,ERRFLG,SWVAL .IF NDF COM8K .GLOBL LSW,OSW,LSTVAL,OLDLOW,FORMCH,SWDSC .ENDC .CSECT ; .PARAM ;REGISTER DEFS, ETC. ; TAB = 11 ;A TAB HAS THE VALUE 11 SPACE = 40 ;A SPACE IS A 40 ; .MACRO RLS EMT 7 .ENDM .MACRO INIT EMT 6 .ENDM .MACRO .CSI2X CSIBLK .CSI2 CSIBLK BPGEN ;GENER LOGICAL EXPRESSION ;GENERATE CODE FOR THE CALL TO THE OTS COMPARISON ROUTINE ;GENERATE ".GLOBL $TRTST" MOV #IF800,R4 ;GET ADDR OF ASCII STRING MOV #IF802-IF800,R5 ;SIZE OF STRING FOR .GLOBL DECLA JSR PC,OUTLN JSR PC,EOL ;OUTPUT CR/LF MOV #IF802-IF801,R5 MOV #IF801,R4 JSR PC,OUTLN JSR PC,EOL ;OUTPUT CR/LF ;NEXT GENERATE "JUMP OVER" ADDRESS FOR THE "FALSE" RETURN. .GLOBL OUTTAB JSR PC,OUTTAB ;WRITE A TAB TO OBJECT FILE ; MOV FLABL,R3 ;GET A SERIAL# MOV R3,-(SP) ; .TITLE IOLIST .IDENT /0711A/ ;DK,RG ; ;COPYRIGHT 1971,1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; .GLOBL GL1,PUTCHR,OUTLN2,CHT1 .GLOBL END1,GET,ZLEQLS,GENLAB,NXTCH .GLOBL PUTNAM,BITM,MISC,OUTGL,EOL .GLOBL OUTNAM,OUTCOM,CURSYM,OUTST,OUTLN1 .GLOBL PARMKM,PARWD,PARXWD,OUTSER .GLOBL PARCNT,DOTMP,DONUM,LINENO,DODON .GLOBL PSHMKM,PSHWD R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=MP R2,R3 ;ARE THEY IN ASCENDING SEQUENCE? BLT ERROR ;NO JSR PC,ENTER ;GO ENTER THE VARIOUS TYPES JSR PC,NXTCH ;LOOK FOR ANOTHER PAREN CMPB R2,#') ;FOUND IT? BNE ERROR ;NO, GIVE ERROR CKCOM: JSR PC,NXTCH ;TRY FOR TERMINATOR TST R2 ;TERMINATOR? BEQ IMPEND ;YES CMPB R2,#', ;COMMA? BEQ IMP01 ;YES, GO LOOK FOR MORE ERROR: TRAP+77. ;WEIRD FORM IN IMPLICIT INC R4 ;FAKE AN ENTRY FOUND 4$: JSR PC,NXTCH ;GET A CHARACTER TST R2 ;END OF LINEIC #177774,(SP) .ENDM ; ; ALL OF FORTRAN STARTS HERE. THE THREE REQUIRED FILES ; ARE INITIALIZED AND A JUMP TO SCANNR IS MADE. ; RSET: .GLOBL OVNUM,DISP,TMPEND,TSTK .GLOBL OPTLEV,OPTLVL CLR OVNUM ;RESET CLR DISP ;THE OVERLAY MOV #TMPEND,TSTK ;CONTROLLER CLR CURLN ;CLEAR BUFFER FLAG FOR RESTART .GLOBL CURLN CLRB SEQSUP ;TURN OFF SEQUENCE SUPPRESS CLRB ARYCHK ;TURN OFF SUBSCRIPT CHECK MOV #OPTLEV,OPTLVL ;DEFAULT SPECIFIED AT LINK TIMESAVE SER.# MOVB #'F,R0 ;OUTPUT TO OBJECT DEVICE JSR PC,OUTSER JSR PC,EOL ;OUTPUT A CR.LF INC FLABL ;NOW IDENTIFY AND TRANSLATE THE STATEMENT IMBEDDED IN THIS IF. MOV #IFTAB,R0 ;ADDR OF TABLE OF EXECUTABLE PRO JSR PC,SCAN2A ;SEARCH TABLE FOR A MATCH BVS IF05 ;IF V=1, NO MATCH.TREAT AS ASSIGNMENT INC INHLAB ;SET "INHIBIT LABEL" SWITCH JMP IFDSP ;GO TO 'IF' DISPATCHING ROUTINE IFRET: ;RETURN HERE FROM 'IF' DISPATCHING .GLOBL GOFLG CLRB GOFLG ;DON'T GIVE EXTRANEOUS PATH ERROR%5 SP=%6 PC=%7 .NLIST BEX .GLOBL IOLIST .CSECT .GLOBL IOL,ARY001,STKCNT .GLOBL OUTOCT,LSTMOD,COUNT,DONUM,IOL ; ; IOLIST - I/O LIST PROCESSING IS DONE HERE ; IOLIST: MOV #100,DONUM JSR PC,LIST00 ;CALL THE FIRST PART OF LIST HANDLER MOV #-1,R2 ;FORCE FINAL JSR PC,TSTM01 ; I/O MOV #FIN00,R4 ;OUTPUT JSR PC,PUTNAM ;SAVE THE NAME BITB BITM+7,MISC+2 ;HAVE WE ALREADY DONE ONE? BNE LSTPR2 ;YES BISB BITM+7,MISC+2 ;SET DONE BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL LSTPR2: JSR PC? BEQ IMPEND ;YES CMPB R2,#', ;COMMA FOUND BNE 4$ ;LOOP UNTIL FOUND BR IMP01 ;GO BACK TO MAIN LOOP SINGLF: CMPB R2,#') ;ALLOW A ) INSTEAD OF A - BNE ERROR ;NOT FOUND MOV R3,R2 ;FUDGE IT BR SINGLG ;AND CONTINUE SINGLE: JSR PC,CHT1 ;THE CHARACTER FOUND MUST BE ALPHA. BVC ERROR ;IT WASN'T MOV R2,R3 ;SET UP ENTER POINTERS SINGLG: JSR PC,ENTER ;AND ENTER THE VALUE BR CKCOM ;GO CHECK TERMINATOR IMPEND: TST R4 ;WERE ANY ENTRIES MAD MOV #400,SWVAL ;VALUE DEPENDENT ON SWITCH ;TABLE ORDER AT SWLST MOV #5,LINCNT ;RESET DEFAULT CONTINUATIONS MOVB #4,TYPSIZ+1 ;RESET THE COMPILER TO MOVB #4,TYPSIZ+2 ;NORMAL OPTIONS .GLOBL START .TRAP #0,#SYNERR ;SET UP TRAPS .RSTRT #START ;SET UP RESTART ADDRESS RSET01: MOV LOWCOR,SP ;GET ROOM TO WORK MOV #LINKL,-(SP) ;IS IT TST @(SP) ;ALREADY INITED? BEQ RSET02 ;NO RLS ;RELEASE IT BR RSET01 RSET02: MOV #LINKK,-(SP) TST @(SP) ; CLR INHLAB ;CLEAR "INHIBIT LABEL" SWITCH IF051: MOV (SP),R3 ;NOW GENERATE ON THE STACK THELABEL MOV #005015,-(SP) ;PUT LINE TERM. ON STACK SUB #10,SP ;MAKE SPACE FOR 6 BYTES MOV SP,R2 JSR PC,OTOA ;CONVERT SERIAL # TO ASCII MOV #"$F,(SP) ;MOVE IN PREFIX TO LABEL MOV #": ,6(SP) ;MOVE IN SUFFIX MOV SP,R4 ;SET UP CALLING SEQ TO OUTPUT SY MOV #12,R5 JSR PC,OUTLN ;OUT GOES THE LINE ;LOGICAL IF DONE. CLEAN UP STACK AND RETURN SUCCESSFULLY. MOV 14(SP),SP IF052: TST (SP)+ ;POP LA,OUTNAM ;OUTPUT THE NAME TSTB -(R1) BEQ LSTPR1 TRAP+12. LSTPR1: RTS PC ; ; THE FIRST PART OF THE LIST PROCESSING CHECKS FOR SIMPLE ; LIST ITEMS AND COMPILES THE CODE FOR THEM. IF, ; DURING THE SCAN, A LEFT PARENTHESIS IS ENCOUNTERED ; WHICH IS NOT PART OF A SUBSCRIPT, PART TWO OF THE ; PROCESSING IS CALLED WHICH IS USED TO HANDLE THE ; PARENTHESIZED OR DO IMPLYING LISTS. NOTE THAT ; PART TWO IS ALLOWED TO CALL PART ONE TO GET SIMPLE ; LISTS EVALUAE? BEQ ERROR ;NO JSR PC,UPDATE ;GO UPDATE EXISTING ENTRIES RTS PC ;AND RETURN ENTER: MOVB R0,IMPTAB-101(R3) ;SET PROPER TYPE INC R3 ;ADVANCE POINTER INC R4 ;UPDATE ENTRY MADE POINTER CMP R3,R2 ;DONE? BLOS ENTER ;NO RTS PC ;YES ; ;UPDATE IMPLICIT ENTRIES IN SYMBOL TABLE ; .GLOBL CURSYM,SYM1WD,UNPK00,DATYMM,DATYWD .GLOBL NAMSER,EXPMKM,EXPWD UPDATE: CLR R0 ;START OUT AT FIRST ENTRY 1$: INC R0 HOW ABOUT THIS ONE? BEQ RSET03 ;NOT THIS ONE RLS ;RELEASE IT BR RSET02 RSET03: JSR PC,RLSALL ;RELEASE EVERYTHING INIT INIT ;TELEPRINTER .GLOBL TTLCNT TSTB TTLCNT ;ISSUE TITLE? BNE FORT09 ;NO INCB TTLCNT MOV #HLGT1,R5 ;OUTPUT MOV #HEAD1,GBUF+6 ;THE MOV #DESC,R4 ;HEADING JSR PC,OUTPUT ;WHICH IS STORED IN THE TABLES FORT09: .IF NDF COM8K MOVB #15,FORMCH ;PRESET THE FORM CONTROL CHARACTER CLR LSW ;RESET LIST SWITCHES CLR OSW ST WORD OFF STACK CLV ;INDICATE SUCCESSFUL RETURN RTS PC ;EXIT IF05: INC INHLAB ;SET "INHIBIT LABEL" SWITCH JSR PC,ASGN ;TREAT WHAT FOLLOWS AS AN ASSIGN CLR INHLAB ;CLEAR "INHIBIT LABEL" SWITCH BR IF051 ; ;ARITHMETIC IF PROCESSOR ; IF04: MOV R5,-(SP) ;SAVE MODE ON STACK JSR PC,GENLAB ;GENERATE STATEMENT LABEL ETC. INCB GOFLG ;SET POSSIBLE PATH ERROR JSR PC,EXPGEN ;GENERATE CODE FOR SUBEXPRESSION MOV (SP)+,R0 ;PUT MODE IN R0 JSR R5,OUTLTED. ; .GLOBL LSTOUT,CUROUT LIST00: MOV #-1,LSTMOD ;CLEAR LAST MODE MOVB #-1,LSTOUT MOVB #-1,CUROUT CLR COUNT ;CLEAR DATA COUNT LIST10: JSR PC,NXTCH ;GET A CHARACTER TST R2 ;IS IT THE END? BEQ LIST05 ;YES LIST01: CMPB R2,#'( ;IS IT A LEFT PAREN? BNE LIST1E MOV #-1,R2 ;FORCE CURRENT I/O JSR PC,TSTM01 ;JUST IN CASE OF DO IMPLIED I/O JMP LIST04 ;YES, DISPATCH TO PART TWO LIST1E: DEC R1 ;BACK UP THE STRING POINTER LIST1A: JSR PC,GET ;GET A LIST ITEM BVS LIST2A ;ILLEGAL LIS;ADVANCE TO NEXT ENTRY CMP R0,SERIAL ;DONE? BGT 99$ ;YES JSR PC,SERATR ;GET SYMBOL LOCATION TST R3 ;IS THIS A VARIABLE? BMI 1$ ;IGNORE CONSTANT DEC R3 MOV R3,-(SP) MOV CURSYM,R3 ;GET ADDRESS OF ENTRY MOV R0,-(SP) ;SAVE R0 MOV R3,R0 ;SET UP ADD #SYM1WD,R0 ;FOR MOV R1,-(SP) ;CALL MOV #DOLST,R1 ;TO UNPACK JSR PC,UNPK00 ;DO THE UNPACK MOV #DOLST,R1 ;FIND OUT WHAT THE FIRST CHARACTER IS MOVB (R1),R2 ;AND PICK IT UP FOR AN INDEX CLR (R1) MOV (SP)+,R1 ;RESTORE MOV (SP) ;AND BINARY SWITCHES .ENDC CLR ISW ;RESET INPUT SWITCH LIST MOV #TEND,R5 ;GET COUNT MOV #TITLE,GBUF+6 MOV #DESC,R4 ;AND I/O DESCRIPTOR JSR PC,OUTPUT ;TELL USER WE ARE HERE .READ #LINKK,#INHD ;GET THE USER RESPONSE .WAIT #LINKK ;WAIT FOR THE USER RESPONSE BIT #060000,INHD+2 ;CHECK FOR EOF OR EOM BNE QUIT CMPB BUFIN,#15 ;IS IT A NULL LINE? BEQ FORT09 ;YES .CSI1 #CMDBUF ;INTERPRET THE COMMAND LINE MOV (SP)+,R1 ;IS IT OK?? BEQ FORT01 ;YES INC R1 ;APPEND MOVB #'?,(R1)+ N2 +IF90 ADD #MODTAB,R0 MOVB @R0,R4 BIC #177400,R4 MOV R4,-(SP) TSTB @R0 BPL 1$ TRAP+141. 1$: JSR PC,OUTCHR JSR PC,EOL JSR R5,OUTLN2 +IF91 MOV (SP)+,R4 JSR PC,OUTCHR JSR PC,EOL ;NOW FIND 3 DESTINATIONS FROM THE INPUT ;STRING AND OUTPUT EACH TO THE OBJECT DEVICE MOV #3,-(SP) ;SET UP LOOP COUNT FOR 3 STATEMENT LABELS IF045: MOV #005015,-(SP) ;PUT CR/LF ON STACK MOV #" ,-(SP) MOV #" ,-(SP) MOV #" ,-(SP) MOV SP,R5 MOV #027011,-(SP) ;PUT A TAB & A DOT ON STACK T ITEM TST R3 ;IS IT A CONSTANT? BMI LIST2A ;ILLEGAL LIST ITEM BGT ARRAY ;GO PROCESS ARRAY ITEM LIST1B: MOVB (R1)+,R3 CMPB R3,#' BEQ LIST1B CMPB R3,#'= BEQ LIST05 CLRB LSTOUT ;SET VARIABLE PUSH JSR PC,TSTMOD DEC R1 JSR PC,PVAR ;GENERATE VARIABLE PUSH BR LIST03 LIST3A: JSR PC,OUTSER ; PROTOTYPE JSR PC,EOL ;FOLLOWED BY AN END OF LINE LIST03: CLR IOL LIST3B: JSR PC,NXTCH ;GET THE NEXT CHARACTER TST R2 ;EXIT IF BEQ LIST05 ; +,R0 ;R0 AND R1 MOV (SP)+,R4 ;GET ARRAY FLAG JSR PC,CHT1 ;IS IT ALPHABETIC? BVC 1$ ;NOPE, MUST BE WEIRD BIT #EXPMKM,EXPWD(R3) ;EXPLICITLY TYPED? BNE 1$ ;YES MOVB IMPTAB-101(R2),R2 ;GET THE IMPLICIT TYPE SWAB R2 ;POSITION IT CORRECTLY TST R4 ;IS THIS AN ARRAY? BNE 3$ ;NO .GLOBL DATYMK MOV DATYWD(R3),R4 ;GET THE OLD TYPE BIC #DATYMK,R4 ;CLEAR OUT JUNK CMP R2,R4 ;DO THE TYPES STILL MATCH? BNE 98$ ;NO, FLAG AS ERROR 3$: BIC #DATYMM,DATYWD(R3) ;CLEAR THE OLD TYPE BIS R2,D; "?" AND MOVB #15,(R1)+ ;BLANK MOVB #12,(R1)+ ;LINE MOVB #12,(R1)+ ;TO MESSAGE SUB #BUFIN,R1 ;GET BYTE COUNT MOV R1,INHD+4 .WRITE #LINKL,#INHD ;OUTPUT THE ERROR BR FORT09 QUIT: .EXIT ;EXIT ON EOF OR EOM FTERR1: MOV #2203,R1 ;TOO MANY SWITCHES BR FTCOM FTERR2: MOV #2204,R1 ;TOO MANY OUTPUT FILES BR FTCOM FTERR3: MOV #2205,R1 ;NO INPUT OR TOO MUCH INPUT FTCOM: CLR -(SP) MOV R1,-(SP) IOT ;OUTPUT THE WORLD'S MOST USELESS DIAGNOSTIC BR FO JSR PC,ISTAT ;GET STATEMENT LABLE TST R4 ;CHECK FOR NO STTMNT FOUND BEQ IF042 IF044: MOV SP,R4 ;ELSE WRITE IT OUT MOV #12,R5 JSR PC,OUTLN IOF421: ADD #12,SP ;BACK UP THE STACK DEC (SP) ;REDUCE LOOP COUNT BEQ IF0431 ;EXIT IF 0. ELSE... CMPB (R1),#', ;DOES A COMMA FOLLOW? BNE IF046 ;IF NOT, ERROR JSR PC,CNXC1 ;ELSE STEP OVER COMMA BR IF045 ;3 STATEMENT LABELS HAVE BEEN PROCESSED. ;CLEAN UP AND GET OUT. IF0431: MOV 2(SP),SP ;POP EVERYTHING OFF STACK BR IF052 IF042: ADD #12,SP ;END OF LINE CMPB R2,#', ;WE MUST HAVE A COMMA IF NOT BNE LIST02 ; JSR PC,NXTCH ;GET ANOTHER CHARACTER BR LIST01 ;AND RE-LOOP LIST05: RTS PC LIST02: CMPB R2,#') BNE LIST2A DEC PARCNT BGE LIST3B CLR PARCNT LIST2A: TRAP+72. ;ILLEGAL LIST ITEM INC R1 ;SKIP OVER BAD ITEM BR LIST10 ;GO BACK TO BEGINNING LIST11: MOV #RPSH,R4 JSR PC,PUTNAM BITB BITM+1,GL1+4 ;CHECK FOR REGISTER PUSH GLOBAL BNE LIST12 BISB BITM+1,GL1+4 ;SET THE OUTPUT DONE FLAG JSR PC,OUTGL ;OUTPUT THE GLOBALATYWD(R3) ;SET UP THE NEW TYPE BR 1$ ;AND LOOP 98$: TRAP+137. ;IMPLICIT OCCURS TOO LATE IN LIFE BR 1$ 99$: RTS PC ;RETURN TO THE REAL WORLD ; .END RT09 FORT01: MOV #2,CMDBUF ;SET FOR OUTPUT .CSI2X #OBJBLK ;GET THE BINARY SPECIFICATION. .IF DF COM8K TST OBJEXT ;DO WE USE THE DEFAULT EXTENSION?? BNE FORT10 ;NO MOV FORT11,OBJEXT ;YES .ENDC FORT10: MOV (SP)+,R1 ;GET COUNT BEQ FORT02 ;GO GET LIST SPECIFICATION IF ZERO CMP R1,#2 ;OR TWO BGE FTERR1 ;TOO MANY SWITCHES CLR LINKSL+6 ;OTHERWISE NO LIST BR FORT05 FORT02: MOV #2,CMDBUF .CSI2X #LSTBLK ;GET THE LIST SPECIFICATION TST LSTECLEAN UP STACK IF046: TRAP +83. ;IMPROPER DESTINATION LABEL SEQU BR IF0431 IF043:IF010: SEV ;INDICATE UNSUCCESSFUL RETURN RTS PC IF011: MOV (SP),SP ;CLEAN UP STACK TST (SP)+ BR IF010 ; ;ISTAT GETS A STATEMENT # FROM THE SOURCE STRING. . ; (R1)=CURRENT CHAR. (1ST TO LOOK AT); SITS ON TERM AT END ; (R5)=WHERE RESULT SHOULD GO R4 CLOBBERED ISTAT: MOV R3,-(SP) ;SAVE R3 MOV R5,R3 ;SET LEADING ZERO FLAG CLR R4 ;INITIALIZE CH COUNT IST2: CMP R LIST12: JSR PC,OUTNAM ;NOW OUTPUT THE NAME BR LIST03 ; ARRAY PROCESSING ARRAY: CMP R3,#2 ;IS THIS A FUNCTION NAME? BEQ LIST02 ;YES, NOT ALLOWED ARR01: MOVB (R1)+,R3 CMPB R3,#' BEQ ARR01 CMPB R3,#'( ; AN ARRAY ELEMENT? BEQ ARYELE ;YES MOVB #-1,LSTOUT DEC R1 MOV #7,R2 ; NO, IT IS THE WHOLE ARRAY JSR PC,TSTMOD ;CHECK FOR COMPATIBLE MODE JSR R5,OUTLN2 ;OUTPUT THE ARRAY PUSH INIT07 MOV R0,R3 ;NOW DO MOV CURSYM,R0 ;SET GENERATE ADBXT ;DEFAULT EXTENSION?? BNE FORT13 ;NO MOV FORT12,LSTEXT ;YES FORT13: MOV (SP)+,R1 BEQ FTERR2 ;ERROR IF MORE FILES CMP R1,#2 ;TOO MANY ITEMS?? BGE FTERR1 ;YES FORT05: CLR CMDBUF ;LOOK .CSI2X #INPBLK ;GET THE INPUT SPECIFICATION TST LINKI+6 ;INPUT SPECIFIED?? BEQ FTERR3 ;NO TST SRCEXT ;EXTENSION SPECIFIED?? BNE FORT03 ;YES MOV FORT14,SRCEXT ;SPECIFY DEFAULT /FTN/ MOV #FORT04,SRCERR ;SET ERROR RETURN FORT03: MOV (SP)+,R1 ;ERROR IF4,#5 BEQ IST1 ;ARE WE DONE BECAUSE COUNT IS EX 2$: JSR PC,CHTEST ;NO, LOOK AT NEXT CH. BPL IST1 ;IF NOT DIGIT, EXIT CMP R3,R5 ;CHECK FOR LEADING ZEROS? BNE 1$ ;NO CMPB (R1),#'0 ;LEADING ZERO? BNE 1$ ;NO JSR PC,CNXC1 ;SKIP IT BR 2$ 1$: MOVB (R1),(R5)+ ;ELSE MOVE IT OUTPUT JSR PC,CNXC1 ;GET NEXT CH. INC R4 BR IST2 IST1: MOV (SP)+,R3 RTS PC ; ;CONSTANTS FOR GENERATING CODE TO CALL THE ;OTS ARITHMETIC COMPARISON ROUTINES ; IF90: .ASCII / .GLOBL/ IF91: .ASCII / $TS/ .BYTE BIT BIS #PSHMKM,PSHWD(R0) MOV #'A,R0 ;THE ADB ADDRESS BR LIST3A ;NOW GO BACK TO MAIN PROCESSING ARYELE: MOVB #1,LSTOUT JSR PC,TSTMOD INC IOL ; MOV SP,STKCNT ;REMEMBER STACK MOV R2,-(SP) ; AND THE MODE JMP ARY001 ;GO TO SUBSCRIPT RECOGNIZER ; ; PART TWO HANDLES PARENTHESES AND IMPLIED DO STATEMENTS ; BADLST: TRAP+90. ;BAD DOSPEC LIST5A: TST (SP)+ MOV (SP)+,R1 RTS PC LIST04: MOV R1,-(SP) ;SAVE THE TEXT POINTER CLR -(SP) ;CLEAR PAREN .TITLE IOPACK .IDENT /0610/ ;RFB 9-MAY-73 ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; .MCALL .READ,.WAIT ; ;ENTRY POINTS .GLOBL ITOA,OUTLN2,OUTCH2,JTOA .GLOBL EOL,GETLN,LSTLIN,OUTCHR,OUTLN,OUTLN1,OUTPUT ;EXTERNAL REFERENCES .GLOBL OUTHD,LINKSL,COMHD .GLOBL BUFIN,BUFOUT,CURLN,GBUF,INHD,LINENO .GLOBL LINKI,LINKOL,SEQNO,TLINE,SEQSUP,SRCLIN,SRCLEG .PSECT ZZZHGH R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11 ;A TAB HAS TH BEQ FTERR3 ;ZERO CMP R1,#2 BGE FTERR1 .IF NDF COM8K BIC #7,SWVAL TST OSW ;IS THERE A BINARY SWITCH? BEQ FORT19 ;NO CMP OSW+2,#"AS ;IS THIS THE ASSEMBLER SWITCH? BNE FTERR1 ;NO BIS #2,SWVAL ;REMEMBER ASSEMBLER SWITCH FORT19: MOV #1,LSTVAL TST LSW ;IS THERE A LIST SWITCH? BEQ FORT20 ;NO CMP LSW,#2 ;IS THERE A SWITCH VALUE? BEQ FORT21 ;YES MOV #1,LSTVAL ;SET DEFAULT FORT21: CMP LSW+4,#"LI ;IS IT "LI"ST?? BNE FTERR1 ;NO BIS #4,SWVAL ;REMEMBER LI SWITCH MOVB @LSW 0 MODTAB: .BYTE 'I,'I+200,'I,'R,'D,'D+200 ; ; ;GLOBL DECLARATION AND CALL TO OTS LOGICAL COMPARE ROUTINE ; IF800: .ASCII / .GLOBL/ IF801: .ASCII / $TRTST/ .BYTE 015,012 ;CR/LF IF802=. ; ; .END ;  COUNT LIST06: JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#'( ;IS IT A LEFT PAREN? BNE LIST07 ;NO INC @SP ;INCREMENT PAREN COUNT BR LIST06 LIST07: CMPB R2,#', ;IS IT A COMMA? BEQ LIST08 ;YES TST R2 ;EXIT BEQ LIST5A ;IF END OF LINE CMPB R2,#') BNE LIST06 DEC @SP BPL LIST06 TST (SP)+ MOV (SP)+,R1 INC PARCNT DEC COUNT ;BACK UP ON FALSE ALARM JMP LIST1A LIST6B: DEC R1 ;BACK UP THE POINTER LIST6A: TST (SP)+ ;POP THE JUNK BR LISTE VALUE 11 SPACE = 40 ;A SPACE IS A 40 ; INIT = EMT+6 ;INITIALIZE OPEN = EMT+16 ;OPEN FILE READ = EMT+4 ;READ FILE WRITE = EMT+2 ;WRITE FILE MWAIT = EMT+1 ;WAIT UNTIL DONE UTIL = EMT+41 ;GENERAL UTILITY CALL CSI1 = EMT+56 CSI2 = EMT+57 CLOSE = EMT+17 RLS = EMT+7 ;RELEASE DEL = EMT+21 ;DELETE EXITM = EMT+60 ;EXIT ; ; GETLN OBTAINS A LINE OF SOURCE INPUT FOR THE COMPILER. ; ANY LINE NUMBERS FOUND ARE STRIPPED AND SAVED. ANY ; CONTINUATIONS+2,LSTVAL ;GET SWITCH SUB #60,LSTVAL ;CONVERT IT TO INTEGER BMI FTERR1 ;BAD SWITCH CMP LSTVAL,#9. ;IS IT TOO BIG? BGT FTERR1 FORT20: .ENDC FORT31: MOV #ISW,R0 ;GET ADDRESS OF SWITCHES FORT16: MOV #SWLST,R1 ;GET ADDRESS OF SWITCH LIST MOV #1,R2 ;GET SWITCH BIT POINTER CLR R3 ;SET SWITCH POINTER TO ZERO DEC (R0)+ ;IS THERE ANOTHER SWITCH? BMI FZRT15 ;NO BEQ FORT29 ;NO, DON'T CHECK FOR VALUE MOV R0,R3 ;GET THE POINTER MOV -2(R3),R4 ;06 LIST08: TST @SP ;IS IT ON THE CURRENT LEVEL? BNE LIST06 ;NO MOV R1,-(SP) ;REMEMBER POSITION JSR PC,GET ;SEE IF IT IS A SIMPLE VARIABLE TST R3 ;RE-LOOP BNE LIST6A ; IF NOT A SIMPLE VARIABLE CMP R2,#2 ;IS IT INTEGER? BNE LIST6A ;NO JSR PC,NXTCH ;GET THE NEXT CHARACTER CMPB R2,#'= ;IS IT AN EQUAL? BNE LIST6B ;NO MOV (SP)+,R1 ;FOUND IT!!! INC IOL INC DONUM ;SET UP MOV #DOTMP+4,R4 ;FOR MOV R4,R3 ;FAKE MOVB DONUM,(R3)+ ;DO CLRB (R3)+ ;LOOP JSR PC,END1 ;GO DO  ARE PROPERLY APPENDED. UPON RETURN TO THE ; COMPILER, THE LINE IS POINTED TO BY R1 AND THE STRING ; IS TERMINATED BY A ZERO BYTE WITH REMOVED. ; REGISTERS CHANGED - ALL. ; GET27: SEV ;SET END-OF-FILE RTS PC ;AND RETURN GETLN: MOV SRCLIN,R1 ;SET LINE POINTER TO ZERO TST CURLN ;IS THERE A LINE ALREADY WAITING? BMI GET27 ;EXIT IF END-OF-FILE BEQ GET00 ;NO IF NOT SET MOV CURLN,R5 ;PICK UP OLD LINE LENGTH BR GET01 ;AND CONTINUE GET20:GET THE SWITCH VALUE COUNT TST (R0)+ ;SKIP OVER VALUE POINTER DEC R4 ;CLECK FOR ONLY ONE SWITCH BNE FTERRX ;MORE THAN ONE!! FORT29: TST (R1) ;DID WE RUN OUT OF LIST? BEQ FTERRX ;YES, DIE QUIETLY ASL R2 ;ADVANCE BIT POINTER CMP (R1)+,(R0) ;IS IT A MATCH BNE FORT29 ;NO BIS R2,SWVAL ;SET IT JSR PC,@SWJMP-SWLST-2(R1) ;GO SET UP THE SWITCH TST (R0)+ ;SKIP OVER SWITCH NAME BR FORT16 ;GO GET NEXT SWITCH FZRT15: JMP FORT15 SWLST: .IF NDF .TITLE IOSTMT .IDENT /0711A/ ;RG ; COPYRIGHT 1973 DIGITAL EQUIPMENT CORPORATION ; MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. .NLIST BEX .GLOBL DECODE,ENCODE,FIND,PRINT,READ,WRITE .GLOBL IOVERB,IOLIST,ZLEQLS R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; THE FOLLOWING ENTRY POINTS, CALLED FROM EXECUT ; SET AN I/O STATEMENT VERB CODE ; AND THEN FALL INTO THE COMMON THE INITIALIZATION BVS BADLST CLR IOL MOV R1,@SP ;REMEMBER END OF DOSPEC MOV 2(SP),R1 MOV (SP)+,@SP JSR PC,LIST00 ;GO GET THE I/O LIST MOV R3,-(SP) MOV #-1,R2 ;FINISH UP THE JUNK JSR PC,TSTM01 CLR COUNT MOV #-1,LSTMOD MOV LINENO,-(SP) ;SAVE REAL LINE NUMBER MOVB DONUM,LINENO DEC DONUM CLRB LINENO+1 INC IOL ;TELL HIM THIS IS I/O JSR PC,DODON ;GO HANDLE DO ENDING CLR IOL ;UN-TELL HIM NOW MOV (SP)+,LINENO ;RESTORE REAL LINE NU JSR PC,LSTL00 ;LIST A COMMENT LINE AND TRY AGAIN GET00: .READ #LINKI,#INHD ;READ AN INPUT LINE .WAIT #LINKI ;WAIT FOR COMPLETION BIT #060000,INHD+2 ;CHECK FOR EOF OR EOM BNE GET26X ;EXIT IF SET MOV #BUFIN,R2 ;GET BUFFER ADDRESSES MOV #BUFOUT,R5 CLR R0 ;SET NULL FLAG INL01: CMP R2,#BUFIN+72. ;IS END OF LINE TO BE FORCED? BHIS INL04A ;YES MOVB (R2)+,R4 ;GET A CHARACTER CMPB R4,#40 ;IS IT A CONTROL CHAR? BEQ INL02A ;A SPACE! BGT INL02 ;NOT A CC CMPB R4,#15 ; IS SPECIAL  COM8K .ASCII /AS/ ;USED BY SWITCH LIST ROUTINE .ASCII /LI/ ;USED BY SWITCH LIST ROUTINE .IFTF .ASCII /ER/ ;ERROR DIAGNOSTICS - COMPREHENSIVE .ASCII /ON/ ;ONE WORD INTEGERS .ASCII /CK/ ;ARRAY BOUNDS CHECKING .ASCII /SU/ ;SEQUENCE SUPPRESSION .ASCII /CO/ ;CONTINUATION LINE SET .ASCII /OP/ ;OPTIMIZATION LEVEL .IFT .ASCII /GO/ ;COMPILE AND GO .IFTF .WORD 0 SWJMP: .IFT FTERRX FTERRX .IFTF FORT22 ;/ER FORT18 ;/ON FORT28 ;/CH FORT17 ;/SU FORT33 ;/CO FOPROCESSING SEGMENT FIND: MOV #-1,R0 BR IOCOM READ: CLR R0 BR IOCOM WRITE: MOV #1,R0 BR IOCOM PRINT: MOV #3,R0 BR IOCOM ENCODE: MOV #4,R0 BR IOCOM DECODE: MOV #5,R0 IOCOM: JSR PC,ZLEQLS ;IS IT A REAL I/O STATEMENT ? BCS 20$ ;NO - TRY FOR ASSIGNMENT JSR PC,IOVERB ;PROCESS I/O VERB PART BCS 10$ ;SOME ERROR - SKIP LIST-PROCESSING JSR PC,IOLIST ;PROCESS I/O LIST 10$: CLV ;INDICATE PROCESSING COMPLETE RTS PC 20$: SEV ;INDICATE NOT I/O STATEMENT RTS PC .END MBER CMPB (SP)+,#'= ;MAKE SURE IT IS CORRECT BEQ LIST9A ;IT IS TRAP+91. ;ILLEGAL LIST LIST9A: MOV (SP)+,R1 ;REMEMBER WHERE DOSPEC ENDS JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#') ;IT MUST BE A RIGHT PAREN BNE LIST09 JMP LIST03 ;GO BACK FOR ENDING LIST09: TRAP+90. ;BAD DOSPEC JMP LIST10 ;TRY TO CONTINUE ; ; CHECK THE CURRENT MODE AGAINST THE LAST ; TSTMOD: TST LSTMOD ;HAS IT BEEN INITIALIZED? BPL TSTM01 ;YES MOV R2,LSTMOD ;NO, SET TO C BEQ INL02A CMPB R4,#12 ; IS MORE SPECIAL BEQ INL04 CMPB R4,#14 ;A IS SPECIAL TOO BEQ INL04C CMP R4,#TAB BEQ INL02A MOVB #'^,(R5)+ ;STORE ^ ADD #100,R4 ;CONVERT TO UPPER CASE INL02: INC R0 ;SET NON-NULL FLAG INL02A: MOVB R4,(R5)+ ;STORE IN BUFFER BR INL01 GET26X: BR GET26 INL04C: MOV #12,R4 ;CONVERT TO BR INL04 INL04A: MOVB #15,(R5)+ ;FORCE MOVB #12,R4 ;END OF LINE MOV #15,(R2)+ ;CLEAR END MOV R4,(R2)+ ;OF INRT40 ;/OP .IFT FORT30 ;/GO .IFTF ; ; HANDLE THE ARRAY BOUNDS CHECKING SWITCH ; FORT28: TST R3 ;WAS THERE A VALUE BNE EREX1 ;YES MOVB #1,ARYCHK ;SET ARRAY CHECKING RTS PC ; ; HANDLE THE SEQUENCE SUPPRESSION SWITCH ; FORT17: MOVB #1,SEQSUP ;SET SUPPRESS SWITCH RTS PC ; ; HANDLE THE ONE WORDS INTEGERS SWITCH ; FORT18: TST R3 ;WAS THERE A VALUE? BNE EREX1 ;YES MOVB #2,TYPSIZ+1 ;SET SINGLE WORD MOVB #2,TYPSIZ+2 ;INTEGERS IN TABLE RTS PC .IFT ; ; HANDLE THE COMPILE URRENT VALUE TSTM01: INC COUNT ;ADVANCE THE COUNT CMP R2,LSTMOD ;ARE THE CURRENT AND LAST MODES EQUAL? BNE 1$ ;THE MODES ARE DIFFERENT TSTB CUROUT ;NOW CHECK THE BMI TSTM02 ;MIXING BGT 2$ ;OF TSTB LSTOUT ;ARRAY ITEMS BGT 3$ ;AND BR TSTM02 ;SIMPLE ITEMS 2$: TSTB LSTOUT BNE TSTM02 3$: CMP COUNT,#1 ;DON'T OUTPUT BEQ TSTM02 ;ZERO ITEMS 1$: MOV LSTMOD,R4 ;GET THE PREVIOUS MODE MOV R2,LSTMOD ;SAVE THE NEW MODE MOV R4,R2 MOV #FMPSH,R4 ;OUTPUT THE JSR PC,PUTNAM ;PUSH PROTOBUF TOO!! INL04: MOVB R4,(R5)+ ;STORE SUB #BUFOUT,R5 ;GET BYTE COUNT CLR CURLN TST R0 ;IS THIS A NULL (COMMENT) LINE? BEQ GET20 ;YES GET01: CLR CURLN ;TURN OFF BUFFER FLAG MOV #BUFIN,R0 CMPB @R0,#'C ;IS IT A COMMENT??? BEQ GET31 ;YES, SO THERE CAN'T BE CONTINUATION MOV #TLINE,R4 ;GET ADDRESS OF STORAGE AREA MOV #6,R2 ;GET COUNT PLUS TWO GET11: DEC R2 ;DECREMENT CHARACTER COUNT BLE GET12 ;EXIT IF DONE MOVB (R0)+,R3 ;GET A CHARACTER CMPB R3,#SPACE ;IGNORE BLANKS BEQAND GO SWITCH ; FORT30: MOVB #1,RUNFG ;TURN ON COMPILE AND GO CLRB RUNCT ;TURN OFF /CC CLRB RUNER ;TURN OFF FATAL FLAG RTS PC .GLOBL RUNFG,RUNCT,RUNER .ENDC ; ; HANDLE THE COMPREHENSIVE ERROR DIAGNOSTIC SWITCH ; FORT22: TST R3 ;WAS THERE A VALUE? BNE EREX1 ;YES MOVB #1,ERRFLG ;SET ERROR FLAG TO ONE RTS PC EREX1: TST (SP)+ FTERRX: JMP FTERR1 ;BAD VALUE ; ; HANDLE THE CONTINUATION LINE SWITCH ; FORT33: TST R3 ;IS THERE A SWITCH VALUE .TITLE IOVERB .IDENT /0711B/ ;DK,RG ; ;COPYRIGHT 1971,1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; .GLOBL PUTCHR,OUTCH2,OUTLN2,CHT1 .GLOBL GET,ZLEQLS,GENLAB,NXTCH,CNXC .GLOBL PUTNAM,BITM,MISC,OUTGL,EOL .GLOBL OUTNAM,OUTCOM,CURSYM,OUTST,OUTLN1,OUTOCT .GLOBL PARMKM,PARWD,PARXWD .GLOBL LSTOUT,RDDEV,WTDEV .GLOBL SCAN2A,OUTSL .GLOBL IOVERB .CSECT R0=%0 R1=%1 R2=%2 TYPE JSR PC,PVX ;AND POSSIBLY A GLOBAL OR TWO MOV COUNT,R3 ;OUTPUT THE DEC R3 JSR PC,OUTOCT ; COUNT MOV #1,COUNT JSR PC,EOL MOV #INIT08,R4 JSR PC,PUTNAM MOVB MODE(R2),R4 ;GET THE MODE JSR PC,PUTCHR ;OUTPUT IT BITB BITM(R2),MISC+3 BNE TSTM04 BISB BITM(R2),MISC+3 ;SET PRESENT BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL TSTM04: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,EOL TSTM02: MOVB LSTOUT,CUROUT ;ADVANCE THE MODES RTS PC .GLOB GET11 CMPB R3,#'0 ;IS IT LEGAL ASCII? BEQ GET24 ;IGNORE LEADING ZEROS BLT GET13 ;NOT LEGAL CMPB R3,#'9 ;CHECK HIGH VALUE BLE GET25 ;LEGAL GET13: CMPB R3,#TAB ;IS IT A TAB? BNE GET14 ;NO, GIVE ERROR GET28: DEC R0 ;BACK UP POINTER BR GET12 ;YES, GO AWAY HAPPY GET25: MOVB R3,(R4)+ ;STORE CHARACTER BR GET11 GET14: CLR TLINE ;SET NOT FOUND FLAG CMP SRCLIN,R1 ;LINE ALREADY STARTED? BNE GET29 ;YES, DON'T ISSUE DUPLICATE ERROR TRAP+2 ? BNE 10$ ;YES 2$: TST (SP)+ ;MUST HAVE A VALUE BR FTERRX 10$: MOV @R3,R3 ;GET ADDRESS OF SWITCH VALUE 1$: MOVB (R3)+,R4 ;GET FIRST DIGIT SUB #60,R4 ;CONVERT TO INTEGER BMI 2$ ;LOUSY INTEGER CMP R4,#9. ;IS IT TOO BIG? BGT 2$ ;YES MOV R2,-(SP) MOVB (R3)+,R2 ;GET THE SECOND CHARACTER SUB #60,R2 ;CONVERT TO INTEGER BMI 6$ ;BAD INTEGER CMP R2,#9. ;IS IT TOO BIG BGT 6$ ;YES MOV R3,-(SP) .GLOBL LINCNT CLC ;MULTIPLY ASL R4 ;R4 MOV R4,R3 ;BY ASL R3 ;TEN ASLR3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .NLIST BEX ; ; THE FOLLOWING CODE HANDLES READ, WRITE, PRINT, AND FIND ; STATEMENTS. ALL REGISTERS ARE USED. ; ON ENTRY, R0 CONTAINS AN INTEGER CODE FOR THE TYPE OF I/O STATEMENT ; THE CODES ARE: ; FIND -1 ; READ 0 ; WRITE 1 ; PRINT 3 ; ENCODE 4 ; DECODE 5 ; RETURNS C=1 IF NO I/O LIST-PROCESSING IS TO FOLLOW ; THUS C=1 FOR 'FIND' AND ON ERRORS ; IOVERB: MOV R0,-(SP) ;SET I/O VERB CODE WHERE EXPECTED BELOW JSR PC,GENLAB ;GENERATE THE LABEL JSRL LIST99 LIST99: MOV STKCNT,R0 ;GET STRING ADDRESS CLR -(SP) ;ADD TERMINATOR TST -(R0) ;POINT TO STRING MOV R2,-(SP) ;REMEMBER TYPE JSR PC,EXPGEN ;GENERATE SOME CODE .GLOBL EXPGEN MOV (SP)+,R2 ;RETAIN TYPE MOV STKCNT,SP JMP LIST11 ; ; GENERATE ADDRESS PUSH FOR VARIABLE ; PVAR: CLRB LSTOUT MOV CURSYM,R0 ;GET ADDRESS OF ENTRY MOV #FMPSH,R4 ;ADDRESS OF PROTOTYPE JSR PC,PUTNAM ;PUT NAME IN LIMBO BIT #PARMKM,PARWD(R0) ;IS IT A PARAMETER??? ;GIVE DIAGNOSTIC TO USER GET29: MOVB (R0)+,R3 ;SKIP OVER CMPB R3,#TAB ;LINE # FIELD BEQ GET28 CMPB R3,#SPACE BNE GET29 CMP R0,#BUFIN+6 BLOS GET5A MOV #BUFIN+6,R0 BR GET5A GET24: CMP R4,#TLINE ;IS THIS A LEADING ZERO BEQ GET11 ;YES, IGNORE IT BR GET25 ;NO, STORE IT GET12: CLRB (R4)+ ;TERMINATE LINE NUMBER GET5A: CMP SRCLIN,R1 ;LINE ALREADY THERE? BEQ GET05 ;NO TSTB TLINE ;IS LINE NUMBER NULL? BNE GET08 ;NO, SO DON'T CHECK CONTINUATION GET05: MOVB (R0)+,R3 ;GET NEXT CH R3 ;FOR DECIMAL ADD R3,R4 ;CONVERSION MOV (SP)+,R3 ;RESTORE R3 ADD R2,R4 ;FINAL VALUE OF SWITCH 5$: MOV (SP)+,R2 ;RESTORE R2 CMPB (R3),#', ;IS IT TERMINATED BEQ 3$ ;BY A COMMA OR CMPB (R3),#'/ ;BY A SLASH BEQ 3$ ;OR CMPB (R3),#15 ;A CARRIAGE RETURN? BNE 2$ ;NO, BAD ERROR 3$: MOV R4,LINCNT ;SET NEW LINE COUNT RTS PC ;RETURN TO CALLER 6$: DEC R3 ;BACK UP OVER BAD CHARACTER BR 5$ ; HANDLE THE OPTIMIZATION LEVEL SWITCH ; FORT40: PC,NXTCH ;GET A CHARACTER CMPB R2,#'( ;IS IT A LEFT PAREN? BEQ 8$ ;YES - NORMAL I/O PROCESSING ; HANDLE SPECIAL SHORT FORMS FOR READ/PRINT TST (SP) ;IS IT A READ STATEMENT ? BNE 2$ ;NO MOV #2,(SP) ;READ IS A SIMPLE FORM MOV #RDDEV,R0 ;FAKE UNIT NUMBER FOR READ BR 4$ ;PROCESS UNIT NUMBER 2$: CMP (SP),#3 ;IS IT A PRINT STATEMENT? BNE BADIO ;NOT READ OR PRINT MOV #WTDEV,R0 ;FAKE UNIT NUMBER FOR PRINT 4$: DEC R1 ;BACK UP THE SCAN POINTER MOV R1,-(SP) ;AND SAVE IT BRIEFLY M?? BEQ PVAR01 ;NO MOV #'P,R4 JSR PC,PUTCHR ;FLAG IT AS A PARAMETER BITB BITM+2,MISC+1 ;DO WE NEED A GLOBL?? BNE PVAR02 ;NO BISB BITM+2,MISC+1 ;YES, SET IT DONE JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ;AND AN END OF LINE PVAR02: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,OUTCOM ;AND A COMMA MOVB PARXWD(R0),R3 ;GET THE PARAMETER INDEX BIC #177400,R3 JSR PC,OUTOCT BR PVAR03 PVAR01: JSR PC,PVX JSR PC,OUTST ;AND THE SYMBOL NAME PVAR03: JSR PC,EOL ;FINALLY AN END OF LINE RTS PARACTER CMPB R3,#TAB ;IS IT A TAB? BEQ GET04 ;YES, GO CHECK FOR SPECIAL CONTINUATION GET02: CMPB R3,#SPACE ;WAS THE CHARACTER A SPACE? BNE GET03 ;NO, CHECK REST OF LINE MOVB (R0)+,R3 ;GET ANOTHER CHARACTER BR GET02 ;AND TRY AGAIN GET31: CMP SRCLIN,R1 ;IS THERE A LINE ALREADY FOUND? BNE GET18 ;YES JMP GET20 ;NO, SO LIST THE COMMENT GET26: MOV #-1,CURLN ;SET END OF FILE CMP R1,SRCLIN ;DO WE ALREADY HAVE A LINE?? BNE GET22 ;YES JMP GET27  TST R3 ;IS THERE A SWITCH VALUE? BNE 1$ ;ERROR IF NOT 2$: TST (SP)+ ;CLEAR RETURN POINTER BR FTERRX ;REPORT ERROR 1$: MOV @R3,R3 MOVB (R3)+,R4 ;GET VALUE CHAR SUB #60,R4 ;SCALE TO NUMERIC RANGE BMI 2$ ;BAD DIGIT CMPB R4,#9. ;TOO HIGH? BGT 2$ MOV R4,OPTLVL ;SAVE AS OPT LEVEL CMPB @R3,#', ;NEXT MUST BE TERMINATOR BEQ 3$ CMPB @R3,#'/ BEQ 3$ CMPB @R3,#15 BNE 2$ ;REPORT ERROR 3$: RTS PC ;ALL IS WELL FORT15: .RLSE #LINKL ;RELEASE TELEPRIOV R0,R1 ;SET TO SCAN FAKE UNIT NUMBER JSR PC,GET ;PLACE IT IN SYMBOL TABLE MOV (SP)+,R1 ;RESTORE SCAN POINTER BR IO002 ;GO FINISH UNIT NUMBER 8$: CMP (SP),#3 ;DON'T ALLOW THE FORM "PRINT (" BEQ BADIO ;ERROR JSR PC,GET ;GET THE UNIT NUMBER BVS BADIO ;NO UNIT NUMBER CMP R2,#2 ;IS IT AN INTEGER?? BEQ IO001 ;YES CMP @SP,#4 ;ENCODE/DECODE? BLT IO01A ;NO, GIVE NORMAL DIAGNOSTIC TRAP+118. ;BAD BUFFER DESCRIPTOR BR IO001 IO01A: TRAP+65. ;NO, GIVE ERROR IO001: CMP R3,#1 C PVX: BITB BITM+1,MISC ;DO WE NEED A GLOBAL? BNE PVAR04 ;NO BISB BITM+1,MISC ;SET THE DONE BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ;AND AN END OF LINE PVAR04: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,OUTCOM ;AND A COMMA RTS PC ; ; MODE: .BYTE 'B,'L,'I,'R,'D,'C,'X,'A .EVEN FMPSH: .ASCII / $PSH/ .BYTE 0 RPSH: .ASCII / $PSHR1/ .BYTE 15,12,0 .EVEN INIT07: .ASCII / $PSH,/ .BYTE 0 INIT08: .ASCII / $IO/ .BYTE 0 FIN00: .ASCII / $IOF/ .BYTE 15,12,0 .EVEN .END ;  ;NO GET03: CMP R0,#BUFIN+6 ;IS THERE A CONTINUATION BHI GET16 ;NO CMP R3,#'0 ;MAYBE, CHECK FOR NULL CONTINUATION BEQ GET08 ;NO CONTINUATION CMPB R3,#40 ;DON'T ALLOW CONTROL CHARS BLE GET09 CMPB R3,#140 ;DON'T ALLOW LOWER CASE BGE GET09 ;WHY??, I DON'T KNOW GET17: CMP SRCLIN,R1 ;CHECK FOR CONTINUATION ON FIRST LINE BNE GET06 ;UNNECESSARY CONTINUATION MARK TRAP+0 ; IF START OF TEXT BUFFER GET06: CMP SRCLIN,R1 ;IS THIS A CONTINUATION? BEQ GET6A ;NO JSR PC,LSTL00 ;YES, DONNTER .RLSE #LINKK ;RELEASE KEYBOARD .INIT #LINKI ;INITIALIZE INPUT FORT27: .OPEN #LINKI,#SRCIN ;OPEN SOURCE INPUT TST LINKSL+6 ;IS THERE A SOURCE LISTING???? BEQ FORT06 ;NO .INIT #LINKSL ;INIT SOURCE LIST DEVICE MOV #LSTDEL,LSTER JSR R5,CKIN ;CHECK FOR SAME NAME +SRCLS ;AS LISTING BVS LSTD1 ;DIFFERENT CLR LSTER ;TURN OFF ERROR HANDLING LSTD1: .OPEN #LINKSL,#SRCLS ;OPEN SOURCE LIST CLR LSTER FORT06: TST LINKOL+6 ;IS THERE ANY OBJECT OUTPUT?? BEQ FORT07 .IF NDF COM8K T;IS IT A VARIABLE OR CONSTANT BLE IO002 ;YES, IT IS CMP @SP,#4 ;ENCODE/DECODE? BLT IO02B ;NO, GIVE NORMAL DIAGNOSTIC TRAP+119. ;ARRAY OR FUNCTION USED IMPROPERLY BR IO002 IO02B: TRAP+66. ;ARRAY OR FUNCTION NAME IS ILLEGAL IO002: JSR PC,PVAR ;GENERATE PUSH CMP @SP,#4 ;IS IT ENCODE/DECODE? BGE IO02A ;YES CMP @SP,#2 ;IS IT A SPECIAL READ OR WRITE?? BGE IO006 ;YES IO02A: JSR PC,NXTCH ;GET A COMMA CMPB R2,#', ; WAS IT A COMMA? BEQ IO005 ; YES,GO GET GOODIES CMP @SP,#4 ; 0 IF READ 'T LIST SEQUENCE NUMBER BR GET19 GET6A: JSR PC,LSTLIN ;LIST THE LINE BEFORE SAVING IT GET19: MOVB (R0)+,R3 ;GET CHAR IN BUFFER CMP R3,#15 ;QUIT ON BNE GET15 JMP GET00 GET15: MOVB R3,(R1)+ ;STORE IN LINE BUFFER MOV SRCLIN,R3 ;DID IT ADD SRCLEG,R3 ;OVERFLOW DEC R3 CMP R1,R3 ;HERE?? BHIS GET21 ;YES BR GET19 GET04: MOVB (R0)+,R3 ;CHECK SPECIAL CONTINUATION CMPB #'1,R3 ;IS IT OK?? BGT GET16 ;NO CMPB #'9,R3 ;CHECK AGAIN BGE GET17 ;GO AWAY IF OK GET16: DEC R0 ;BACK UST OBJEXT ;OBJECT DEFAULT EXTENSION? BNE FORT24 ;NO TST OSW ;WHICH IS IT BEQ FORT25 ;JUMP IF .OBJ MOV FORT11,OBJEXT ; .PAL BR FORT24 FORT25: MOV FORT23,OBJEXT ; .OBJ FORT24: .ENDC .INIT #LINKOL ;INITIALIZE OBJ OUTPUT MOV #OBJDEL,OBJER JSR R5,CKIN ;IS THE NAME THE +OBJLS ;SAME AS THE OBJECT? BVS OBJD1 ;NO CLR OBJER ;YES, LET MONITOR HANDLE IT OBJD1: .OPEN #LINKOL,#OBJLS CLR OBJER FORT07: .IF NDF COM8K .GLOBL LINKAS,ASMLS IS IT ENCODE/DECODE? BGE BADIO ;YES, MUST BE AN ERROR CMPB R2,#') ;IS IT A RIGHT PAREN??? BEQ IO003 ;YES, UNFORMATTED I/O CMPB #'',R2 ;IS IT A SINGLE QUOTE?? BEQ IO010 ;YES, IT IS RANDOM ACCESS BADIO: TST (SP)+ ;CLEAR ITEM FROM STACK BADIO1: TRAP+67. ;ILLEGAL I/O STATEMENT FORM SEC ;INDICATE ERROR RTS PC ;AND RETURN IO003: TST @SP ;IS IT A LEGAL UNFORMATTED I/O?? BPL IO004 ;YES TRAP+68. ;MISSING ARGUMENT IO004: CLR -(SP) ;SET UNFORMATTED MODE JMP IOGEN ;GO HANDLE ADIRECTORY DT0: [ 1,1 ] 23-OCT-73 COMBLD.BAT 8 28-SEP-73 <233> 017776 DGNBLD.BAT 2 28-SEP-73 <233> 067767 ASC2 .MAC 5 28-SEP-73 <233> 121652 ASF .MAC 13 28-SEP-73 <233> 036500 ASGMNT.MAC 7 28-SEP-73 <233> 111405 CODGEN.MAC 77 28-SEP-73 <233> 112666 COMMON.MAC 56 28-SEP-73 <233> 042461 CORET .MAC 5 28-SEP-73 <233> 114261 DATA .MAC 36 28-SEP-73 <233> 017576 DECLAR.MAC 14 28-SEP-73 <233> 130214 DP POINTER GET08: CMP SRCLIN,R1 ;CHECK FOR LINE ALREADY FOUND BNE GET18 ;NO MORE, REMEMBER WHAT GOES ON MOV #TLINE,R3 ;GET ADDRESS OF TEMP. LINE MOV #LINENO,R4 ;GET PERMANENT LINE NUMBER MOV (R3)+,(R4)+ ;MOVE MOV (R3)+,(R4)+ ; TO MOV (R3)+,(R4)+ ; PERMANENT AREA BR GET06 ;GO TRANSFER TEXT GET18: MOV R5,CURLN ;SAVE BYTE COUNT UNTIL NEXT TIME GET22: CLRB (R1)+ ;STORE TERMINATOR IN BUFFER MOV SRCLIN,R1 ;GET ADDRESS OF BUFFER GET23: RTS PC ;RETURN TO CALLER GET09: TRAP+1 ;ILLEGAL CO TST OSW ;ASSEMBLE THE STUFF? BNE FORT26 ;NO .INIT #LINKAS ;INIT ASSEMBLER MOV #TMPDEL,ASMLS-4 ;SET ERROR RETURN TMPD1: .OPEN #LINKAS,#ASMLS ;OPEN ASSEMBLER FILE CLR LINKAS-4 ;CLEAR ERROR BR FORT26 TMPDEL: CLR ASMLS-4 ;DELETE .DELET #LINKAS,#ASMLS ;DELETE ASSEMBLER FILE BR TMPD1 FORT26: .ENDC MOV LOWCOR,SP ;SET UP THE STACK POINTER .MONF ;GET THE LOWEST AVAILABLE ADDRESS MOV (SP)+,MTOP ;REMEMBER THE ADDRESS MOV LINCNT,R5 ;COMPUTE THLL THE COMMON GOODIES IO005: MOV R1,R5 ;SAVE TEXT POINTER CMP @SP,#4 ;ENCODE/DECODE? BGE IO006 ;YES, DON'T LOOK FOR END OR ERR YET MOV #OPTLST,R0 ;GET ADDRESS OF END, ERR PROTOTYPES JSR PC,SCAN2A ;CHECK FOR ONE OF THEM BVS IO006 ;NOT PRESENT, TRY FOR FORMAT MOV R5,R1 ;UNFORMATTED BR IO004 ;GO HANDLE UNFORMATTED IO006: MOV R1,R4 ;REMEMBER CHARACTER POINTER JSR PC,NXTCH ;GET A CHARACTER JSR PC,CHT1 ;IS IT NUMERIC? BMI IO06A ;YES DEC R1 .GLOBL NOCNSV INCB NOCNSV ;SUPRESSEFINE.MAC 8 28-SEP-73 <233> 165276 DO .MAC 12 28-SEP-73 <233> 116451 DOFIN .MAC 8 28-SEP-73 <233> 144747 ELOC .MAC 2 28-SEP-73 <233> 020264 ENDPRO.MAC 35 23-OCT-73 <233> 022574 ENDSTM.MAC 3 28-SEP-73 <233> 155367 ERRLOC.MAC 4 28-SEP-73 <233> 165634 ERRPRT.MAC 14 23-OCT-73 <233> 077544 EXECUT.MAC 10 28-SEP-73 <233> 146561 EXTERN.MAC 4 28-SEP-73 <233> 025462 FORMAT.MAC 17 28-SEP-73 <233> 103065 FUNNANTINUATION MARK, IGNORED BR GET06 ;GO PROCESS LINE ANYWAY GET21: CLR CURLN ;THROW AWAY EXCESS LINE TRAP+6 ;TELL USER BR GET22 ;AND EXIT ; ; LSTLIN - LIST LINE ON SOURCE AND OBJECT DEVICES, R5 HAS COUNT ; LINE IS IN BUFOUT. REGISTERS CHANGED - R4,R5. ; LSTL00: MOV R5,-(SP) MOV NBUF+4,NBUF MOV NBUF+4,NBUF+2 BR LSTL03 LSTLIN: TSTB SEQSUP ;SUPPRESS SEQUENCING? BNE LSTL00 ;YES MOV R5,-(SP) MOV R3,-(SP) ;SAVE R3 MOV SEQNO,R4 ;GET THE E MOV #72.,R0 ;SIZE MOV R0,R1 ;OF 1$: DEC R5 ;THE WORK BUFFER BMI 2$ ;EXIT IF NO MORE CONTINUATIONS ADD R0,R1 ;ADD LENGTH OF CURRENT CONTINUATION BR 1$ ;LOOP UNTIL COMPLETE 2$: MOV R1,SRCLEG ;PUT AWAY THE TOTAL LENGTH SUB R1,SP ;MAKE ROOM FOR IT MOV MTOP,R1 ;GET MONITOR TOP MOV SP,SRCLIN ;SET UP START OF BUFFER ; SET UP FINAL COMPILER STACK SPACE ; ADD #512.+100.,R1 ;MINIMUM ROOM CMP DPTR+2,#256. ;>256. IMPLIES RP03 BGT 4$ ;IN WHICH CASE NEED EVEN MORE .CORE ;IF ME  SYMBOL ENTRY FOR FORMAT JSR PC,GET ;FIND OUT WHAT IT IS CLRB NOCNSV ;TURN OFF SUPPRESSION TST R3 ;IS IT A CONSTANT? BMI IO06A ;YES, GO HANDLE NORMALLY BEQ IO007 ;NO CMP R3,#1 ;IS IT AN ARRAY? BNE IO007 ;NO JSR PC,PVAR ;OUTPUT THE ARRAY NAME BR IO06B ;GO COMPLETE THE JOB IO06A: MOV R4,R1 MOV #FMPSH,R4 ;GET ADDRESS OF $PSH JSR PC,PUTNAM JSR PC,PVX JSR R5,OUTCH2 '$ JSR PC,OUTSL ;OUTPUT THE FORMAT NUMBER BVS IO007 ;ERROR OF NO NUMBER MOV #FMTLB1,R4 ;OUTPUT NORMAL M.MAC 6 28-SEP-73 <233> 167302 GCMPLX.MAC 10 28-SEP-73 <233> 154237 GENOVL.MAC 10 28-SEP-73 <233> 164202 GOTO .MAC 19 28-SEP-73 <233> 127217 HDRGEN.MAC 10 28-SEP-73 <233> 134154 HEAD00.MAC 3 28-SEP-73 <233> 163716 HEAD01.MAC 4 28-SEP-73 <233> 056061 HEAD02.MAC 6 28-SEP-73 <233> 173506 HEAD03.MAC 6 28-SEP-73 <233> 166155 HEAD04.MAC 3 28-SEP-73 <233> 116014 IF .MAC 13 28-SEP-73 <233> 002775 IMPLIC.MA SEQUENCE NUMBER MOV #NBUF,R3 ;AND THE BUFFER ADDRESS JSR PC,ITOA ;CONVERT TO INTEGER MOV (SP)+,R3 LSTL03: .IF NDF COM8K .GLOBL LSTVAL ;NEED A LISTING? TST LSTVAL BEQ LSTL04 ;NO JSR PC,PAG .IFTF MOV #8.,R5 ;GET SHORT COUNT MOV #LISTL0,R4 JSR PC,OUTPUT ;OUTPUT THE LINE NUMBER MOV (SP)+,R5 ;RESTORE R5 MOV #LSTL01,R4 ;DESCRIPTION OF OUTPUT RO R4 JSR PC,OUTPUT ;OUTPUT A LINE .IFT CMP LSTVAL,#1 ;IS LISTING OF OBJECT NEEDED? BGT LS MORY IS MOV (SP)+,R0 ; CMP R0,#37776 ;8K BLOS 5$ ;THEN NO MORE CMP R0,#57776 ;IF 12K THEN ALLOW 200. MORE BEQ 3$ 4$: ADD #512.,R1 ;ELSE BE GENEROUS 3$: ADD #200.,R1 5$: CMP SP,R1 ;DID WE OVERFLOW HERE? BLOS STKOVF ;YES, DIE IN AGONY MOV SP,FRHIGH ;SET FREE CORE HIGH ADDRESS MOV R1,FRLOW ;SET FREE CORE LOW ADDRESS MOV R1,OLDLOW MOV R1,SP ;RELOCATE STACK POINTER TO FINAL REST .GLOBL OLDLOW .GLOBL LOWCOR,MTOP,LINCNT,SRCLEG,SRCLIN,FRHIGHTERMINATOR IO008: JSR PC,OUTLN1 IO06B: MOV #1,-(SP) ;SET FORMATTED MODE BR IO014 IO007: MOV #FMTLAB,R4 ;OUTPUT ERROR TRAP+92. ;TELL HIM FORMAT IS BAD BR IO008 ; TERMINATOR IO010: MOV #-1,-(SP) ;RANDOM ACCESS I/O JSR PC,GET ;GET THE BVC IO011 ; RECORD NUMBER IO012: TRAP+69. ;ILLEGAL RECORD FORMAT IO013: CMP (SP)+,(SP)+ ;POP JUNK SEC RTS PC IO011: TST R3 ;IS IT A VARIABLE OR CONSTANT? BGT IO012 ;NO CMP R2,#2 ;IS IT INTEGER? BNE IO012 ;NO JSR PC,PVAR ;OUTPUT THE PUSH C 9 28-SEP-73 <233> 021004 INIT .MAC 40 28-SEP-73 <233> 123401 IOLIST.MAC 18 28-SEP-73 <233> 064733 IOPACK.MAC 28 28-SEP-73 <233> 056426 IOSTMT.MAC 3 28-SEP-73 <233> 163354 IOVERB.MAC 22 28-SEP-73 <233> 026732 FREE BLKS: 12 FREE FILES: 18 TL05 ;YES, PUT LINES IN AS COMMENTS TST OSW ;IS USER SPECIFYING /AS? BEQ LSTL06 ;NO, DON'T WASTE TIME ON COMMENTS .IFTF LSTL05: INC R5 ;ALLOW POINTER TO INCLUDE ";" MOV #LSTL02,R4 ;DESCRIPTION OF OBJECT OUTPUT JSR PC,OUTPUT ;OUTPUT THE LINE LSTL06: RTS PC ;AND RETURN .IFT LSTL04: MOV (SP)+,R5 RTS PC .ENDC LSTL01: OUTHD ;SOURCE LIST BUFFER LINKSL ; AND LINK BLOCK LSTL02: COMHD ;OBJECT OUTPUT BUFFER LINKOL ; AND LINK BLOCK LISTL0: NUMHD LINKSL NUMHD: 8. 2 8. NB,FRLOW MOV #STCLR,R0 ;NOW FORT08: CLR (R0)+ ;CLEAR THE CMP R0,#ENDCLR ;TABLE BLO FORT08 ;LIST MOV FRLOW,SYMBAS ;THIS IS WHERE THE TABLE STARTS MOV SYMBAS,SYMEND ;GET END OF SYMBOL TABLE ADD #160.,SYMEND ;SET IT INITIALLY TO 10 SYMBOLS MOV SYMEND,FRLOW MOV SYMBAS,SYMCUR ;SET START OF ADD #2,SYMCUR ;FREE SPACE INC SERIAL ;SET SERIAL START TO ONE INC FLABL ;PRESET INTERNAL LABEL POINTER .IF NDF COM8K CLR PAGNUM MOV #60.,LINCT .GLOBL PAGNUM,LINCT .GLOBL TIM .TMCVT #TIM IO014: CMP 2(SP),#4 ;IS THIS ENCODE/DECODE? BGE EDCOD ;YES, GO GET ARRAY ADDRESS CMP #2,2(SP) ;IS THE CLASS 2 OR 3? BGT IO016 ;NO SUB @PC,2(SP) ;YES, CONVERT IT TO NORMAL CLASS(!! ?? !!) JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#', ;IS IT A COMMA?? BEQ IO017 ;YES TST R2 ;IS THIS END OF LINE? BEQ IO17A ;YES, ALLOW IT TRAP+85. ;NO, ERROR BR IO013 IO17A: DEC R1 ;BACK UP OVER TERMINATOR IO017: MOVB #'),R2 ;PRETEND IT IS NORMAL READ OR WRITE BR IOGEN ;GO HANDLE REST OF STUFF IUF: .ASCII /0000 / .EVEN ; ; ITOA - INPUT IN R4 CONVERTED TO ASCII IN R3 LIST ; JTOA: MOV #ITA03,R5 BR ITA01 ITOA: MOV #ITA03+2,R5 ;GET POINTER TO FUDGES ITA01: MOVB #57,@R3 ;SET UP DIVIDEND FUDGE ITA02: INCB @R3 ;INCREMENT COUNT SUB @R5,R4 ;SUBTRACT THE CONSTANT BPL ITA02 ;LOOP UNTIL SIGN CHANGE ADD (R5)+,R4 ;NOW MAKE IT GOOD AGAIN INC R3 ;SKIP OVER CONVERTED CHARACTER TST @R5 BNE ITA01 ;LOOP FOR FOUR CHARACTERS RTS PC ITA03: 100;GET THE TIME OF DAY .GLOBL PAG JSR PC,PAG ;EJECT THE FIRST PAGE MOVB #14,FORMCH ;RESET FORM CONTROL TO .ENDC CLR ALOKAT CLR COMCLR CLR COMUN CLR EQVHED MOV FRHIGH,OLDHGH ;REMEMBER OLD HIGH FOR LATER USE MOV #IMPTAB,R0 ;GET READY TO SET UP IMPLICIT IMPLP: MOVB #030,(R0)+ ;PRESTORE TYPE "REAL" CMP R0,#IMPTAB+26. ;ALL 26 LETTERS BLO IMPLP ;ARE DONE MOV #IMPTAB+8.,R0 ;POINT TO INTEGERS IMPLP2: MOVB #020,(R0)+ ;PRESTORE "INTEGER" CMO016: JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#') ;END OF I/O DESCRIPTION?? BNE MPAR ;NOT NECESSARILY BR IOGEN MPAR: CMPB R2,#', ;CHECK FOR COMMA BEQ IOGEN ;JUMP IF OK TRAP+70. ;GIVE MISSING PAREN ERROR BR IO013 ; EDERR: TRAP+117. ;NO BUFFER ADDRESS BR IO013 ;PUNT ; EDCOD: JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#', ;IS THERE A COMMA PRESENT? BNE EDERR ;NO, OOPS JSR PC,GET ;GET THE ARRAY DESCRIPTOR CMP R3,#1 ;IS IT AN ARRAY?? BNE EDERR ;NO JSR PC,PVAR ;YES, GO OUTPUT00. 1750 ;1,000 144 ;100 12 ;10 1 ;1 0 ;TERMINATOR ; ; OUTFIN - EMPTY THE TEMPORARY BUFFER ; .GLOBL OUTFIN OUTFIN: MOV R4,-(SP) MOV R5,-(SP) CMP CHRPNT,#CHRBUF ;IS BUFFER EMPTY? BEQ OUTPTX ;YES MOV CHRPNT,R5 ;GET POINTER SUB #CHRBUF,R5 ;GET COUNT MOV #CHRBUF,GBUF+6 ;STORE ADDRESS MOV #OUTL01,R4 ;GET HEADER STUFF JSR PC,OUTPTI ;OUTPUT THE BLOCK MOV #CHRBUF,CHRPNT ;SET POINTER TO EMPTY OUTPTX: MOV (SP)+,R5 MOV (SP)+,R4 RTSP R0,#IMPTAB+14. ;IN 6 OF THEM BLO IMPLP2 ;NOW WE HAVE A FRESH TABLE MOV #ERRS,ERRCUR ;INITIALIZE ERROR TABLE JMP SCANNR ;GO DO SOME FORTRAN STKOVF: MOV PC,-(SP) MOV #1401,-(SP) ;SET STACK OVERFLOW ERROR IOT ;F001 ERROR ;THE DEFAULT EXTENSION ON INPUT WAS NOT THERE FORT04: CLR SRCERR ;TURN OFF ERROR RETURN CLR SRCEXT ;SET NULL EXTENSION JMP FORT27 ;GO TRY TO FIND IT LSTDEL: CLR LSTER .DELET #LINKSL,#SRCLS ;DELETE LISTING FILE JMP LSTD1 OBJDEL: CLR OBJER ;DELETE .DELET #LINK THE MESS BR IO016 ;AND CONTINUE ; ; UPON ENTRY TO IOGEN, R2 WILL CONTAIN EITHER A COMMA OR A ; RIGHT PAREN. IF A COMMA, THE END AND ERR CONDITIONS ; MUST BE CHECKED, IF A RIGHT PAREN, END AND ERR ARE NULL. ; ; THE TOP OF THE STACK IS: ; -1 IF RANDOM ACCESS ; 0 IF UNFORMATTED ; +1 IF FORMATTED ; ; THE SECOND ITEM OF THE STACK IS: ; -1 IF FIND ; 0 IF READ ; +1 IF WRITE ; +4 IF ENCODE ; +5 IF DECODE ; IOG06: BISB BITM+5,MISC+4 ;SET ENCODE FLAG MOV #P8,R4 ;GET ADDRESS OF ENCODE S PC ; ; OUTPUT - OUTPUT A LINE, R4 POINTS TO THE I/O DESCRIPTOR, R5 CONTAINS ; THE CHARACTER COUNT. THE I/O DESCRIPTOR CONSISTS OF ; TWO WORDS, THE FIRST OF WHICH IS THE ADDRESS OF THE ; DESIRED BUFFER HEADER, THE SECOND OF WHICH IS THE ; CORRESPONDING LINK BLOCK ADDRESS. ; REGISTERS CHANGED - R4,R5. ; OUTPUT: CMP 2(R4),#LINKOL ;IS THE OUTPUT TO THE BINARY FILE? BNE OUTPTI ;NO, DON'T DUMP SMALL BUFFER JSR PC,OUTFIN ;TERMINATE LOCAL BUFFER OUTPTI: MOOL,#OBJLS ;DELETE OBJECT FILE JMP OBJD1 EXIT: MOV #DOLST,R5 ;GET A TEMPORARY BUFFER MOV R5,GBUF+6 ;REMEMBER WHERE IT IS TST SWVAL ;ANY SWITCHES? BEQ 99$ ;NO MOV #1,R0 ;PRESET THE MASK MOV #SWLST,R2 ;GET PROTOTYPE LIST MOV #/2,R1 ;NUMBER OF WORDS TO TRANSFER MOV #SWPRT,R3 1$: MOV (R3)+,(R5)+ ;STORE A WORD DEC R1 ;DONE YET? BNE 1$ ;NO 2$: ASL R0 ;SHIFT THE MASK INTO POSITION BCS 5$ ;ARE WE DONE? BIT R0,SWVAL ;IS THE SWITTRING BR IOG6B IOG6A: BISB BITM+6,MISC+4 ;SET DECODE FLAG MOV #P9,R4 ;GET ADDRESS OF DECODE STRING IOG6B: JSR PC,PUTNAM ;GET THE NAME BITB BITM-4(R5),MISC+5 ;DO WE ALREADY HAVE IT? BNE IOG03 ;YES BISB BITM-4(R5),MISC+5 ;NO, BUT SET IT FOUND BR IOG06C ;AND OUTPUT THE REST OF IT ; IOGEN: MOV 2(SP),R5 ;GET THE I/O TYPE BLT IOG04 ;SKIP IF FIND BGT IOG05 ;IT IS A WRITE BISB BITM+0,MISC+4 ;SET THE READ GLOBAL BR IOG04 IOG05: CMP R5,#4 ;IS IT ENCODE/DECODE? BEQ IOG06 ;YES, DON'T V R3,-(SP) ;SAVE R3 MOV (R4)+,R3 ;GET HEADER ADDRESS MOV R5,4(R3) ;SAVE BYTE COUNT MOV R3,-(SP) ;PUSH BUFFER HEADER POINTER MOV (R4)+,R3 ;GET LINK BLOCK .IF NDF COM8K .GLOBL OSW,LINKAS TST OSW ;IS THIS ASSEMBLER OUTPUT? BNE OUT002 ;NO CMP R3,#LINKOL ;IS THIS TO THE ASSEMBLER FILE? BNE OUT002 ;NO MOV #LINKAS,R3 ;YES, SUBSTITUTE DIFFERENT FILE OUT002: .IFTF TST 6(R3) ;IS IT BEING USED? BEQ OUTNO ;NO, DON'T OUTPUT IT MOV R3,-(SP) ;STORE LINK BLOCK CMP R3,#LINKOL ;IS THE !CH SET? BNE 3$ ;YES TST (R2)+ ;SKIP OVER ASCII SWITCH BR 2$ ;CONTINUE LOOP 3$: MOVB #'/,(R5)+ ;STORE A SLASH MOVB (R2)+,(R5)+ ;AND THE MOVB (R2)+,(R5)+ ;SWITCH NAME CMPB #'P,-1(R5) BNE 4$ CMPB #'O,-2(R5) BNE 4$ MOVB #':,(R5)+ MOVB OPTLVL,R4 ADD #'0,R4 MOVB R4,(R5)+ 4$: MOVB #',,(R5)+ ;NOW A COMMA BR 2$ ;GO DO NEXT SWITCH 5$: DEC R5 ;BACK UP OVER LAST COMMA MOVB #15,(R5)+ ;STORE MOVB #12,(R5)+ ;TERMINATOR SUB #DOLST,R5 ;GET LINE LENGTH MOV #SWDSC,R4 ;GET DESCRIPT" NEED GLOBAL HERE BGT IOG6A BISB BITM+1,MISC+4 ;SET THE WRITE GLOBAL IOG04: INC R5 ;AND MOV R5,R3 ; MULTIPLY ASL R3 ; BY ADD R3,R5 ; THREE MOV @SP,R3 ;GET THE INC R3 ; FORMATTING ADD R3,R5 ;WE NOW HAVE A TABLE INDEX SUB #2,R5 ; WHICH MAY BE USED TO OUTPUT ASCII BPL IOG01 ;FUDGE CLR R5 ; THE FIND INDICATOR IOG01: MOV R5,R3 ;PICK UP A WORD ASL R3 ; INDEX TOO MOV IOG02(R3),R4 ;GET ASCII ADDRESS JSR PC,PUTNAM ;GET THE NAME BITB BITM(R5),MISC+2 ;SEE IF WE ALREADY $OUTPUT ON THE OBJECT DEVICE? BEQ OUT004 ;YES .IFF BR OUT001 .IFT CMP R3,#LINKAS BNE OUT001 .IFTF OUT004: MOV 2(SP),R3 ;GET BUFFER HEADER CMP 4(R3),#64. ;IS THE BYTE COUNT > 64.?? BLE OUT001 ;NO, FIXING NOT NEEDED MOV #64.,4(R3) ;RESET THE BYTE COUNT MOV 6(R3),R3 ;GET THE ADDRESS OF THE BUFFER MOVB #15,62.(R3) ;AND TERMINATE MOVB #12,63.(R3) ;THE BUFFER OUT001: WRITE ;DO THE WRITE MOV -(R4),-(SP) ;GET LINK BLOCK POINTER AGAIN .IFT TST OSW ;IS THIS ASSEMBLER OUTPUT? %OR BLOCK JSR PC,OUTPUT ;PUT OUT THE LINE 99$: .IF NDF COM8K TST OSW ;ASSEMBLY NEEDED? BNE EXIT1 ;NO .CLOSE #LINKAS ;CLOSE ASSEMBLER FILE JSR PC,PALFTN ;GO ASSEMBLE IT .GLOBL PALFTN .GLOBL CURLN MOV R1,R4 ;GET THE ASSEMBLER USED CORE MOV #ASMUSE,R3 ;GET ADDRESS OF ASCII BUFFER JSR PC,JTOA ;CONVERT TO ASCII MOV R0,R4 ;GET FREE CORE MOV #ASMFRE,R3 ;AND ADDRESS JSR PC,JTOA ;CONVERT TO ASCII JSR PC,PRXSUM ;PRINT THE CORE SUMMARY ;C&HAD ONE BNE IOG03 BISB BITM(R5),MISC+2 ;SET FOUND BIT IOG06C: JSR PC,OUTGL ;GENERATE THE JSR PC,EOL ; GLOBAL IOG03: JSR PC,OUTNAM ;NOW OUTPUT THE NAME JSR PC,OUTCOM ;AND CONTINUE TST (SP)+ ;DISCARD TOP OF STACK CMP R2,#') ;IS THIS A NULL END OR ERR?? BNE IOG07 ;NO JSR R5,OUTLN2 ;YES, OUTPUT A NULL LIST INIT05 IOG14: TST (SP) ;IS THE I/O VERB 'FIND' ? BPL IOGOK ;NO - ALL OK JSR PC,CNXC ;CHECK FOR END OF LINE AFTER 'FIND' BEQ IOGERR ;OK, BUT SET C=1 FOR 'FIND' TRAP+12.( BNE OUT003 ;NO CMP @SP,#LINKOL BNE OUT003 MOV #LINKAS,@SP ;YES, SELECT DIFFERENT FILE OUT003: .ENDC MWAIT ;WAIT FOR COMPLETION MOV -(R4),R3 ;BUFFER HEADER ADDRESS BITB #100,3(R3) ;END-OF-MEDIUM? BEQ OUT1 MOV PC,-(SP) ;REQUEST ADDRESS MOV #1400+6,-(SP) ;F006 IOT ;DOES NOT RETURN OUT1: MOV (SP)+,R3 ;RESTORE R3 RTS PC OUTNO: TST (SP)+ ;DISCARD ELEMENT ON STACK BR OUT1 ; ; OUTLST - OUTPUT TO LISTING DEVICE ONLY ; INPUT: R4 = TEXT START ; R5 = CHAR COUNT ; NOTE: APPEN)HECK FOR FATAL ASSEMBLE PHASE ERROR ;I.E. SYMBOL TABLE OVERFLOW ;IF FOUND THEN END THIS COMPILATION NOW CMP #ERRS,ERRCUR BNE EXIT1B ;YES - ERROR TST CURLN ;WAS THERE AN EOF ON INPUT? BMI EXIT1B ;YES INCB RUNCT ;SET /CC SWITCH JMP FORT07 .IFTF EXIT1: JSR PC,PRTSUM .IFF MOV LOWCOR,SP ;RESET STACK FOR 8K USER .ENDC EXIT1B: CLR CURLN ;RESET END OF FILE FLAG JSR PC,RLSALL ;TURN OFF ALL CURRENT FILES .INIT #LINKK ;RE-INIT THE .INIT #* ;ILLEGAL STATEMENT FORM IOGERR: TST (SP)+ ;POP I/O VERB CODE SEC ;INDICATE SOME ERROR RTS PC IOGOK: TST (SP)+ ;POP I/O VERB CODE, SET C=0 RTS PC BADIO2: TST (SP)+ ;POP JUNK ITEM JMP BADIO1 ;AND CALL REAL ERROR IOG07: MOV #OPTLST,R0 ;CHECK JSR PC,SCAN2A ; FOR END= OR ERR= BVS BADIO2 ;NOT A LEGAL FORM TST R0 ;WAS END= SPECIFIED? BGT IOG08 ;NO JSR R5,OUTCH2 ;YES, OUTPUT '. JSR PC,OUTSL ;THE LABEL BVS IOG09 JSR PC,OUTCOM ;NOW OUTPUT A COMMA JSR PC,NXTCH ;GET THE,DS A TO END OF TEXT ; .GLOBL OUTLST,GBUF,LINKSL OUTLST: JSR PC,PAG MOV R4,GBUF+6 MOV #SWDSC,R4 JSR PC,OUTPUT MOV #EOL1,GBUF+6 MOV #2,R5 MOV #SWDSC,R4 JSR PC,OUTPUT RTS PC ; SWDSC: .WORD GBUF,LINKSL ;DOS DECSRIPTOR ; ; OUTLN - OUTPUT A LINE OF ASCII TO THE OBJECT DEVICE. R4 HAS ; ADDRESS OF THE STRING, R5 HAS THE COUNT. ; REGISTERS CHANGED - R4,R5. ; .GLOBL CHRBUF,CHREND,CHRLG,CHRPNT OUTLN: MOV R3,-(SP) ;SAVE R3 OUTX03: MOV C-LINKL ;TELETYPE ; OUTPUT THE ERROR COUNT IF ANY MOV ECNT,R4 ;GET ERROR COUNT BEQ FORT9A ;EXIT IF NONE CLR ECNT ;CLEAR COUNT MOVB #' ,R2 CMP R4,#1 ;ONLY ONE ERROR?? BEQ FORT9B ;YES MOVB #'S,R2 ;MORE THAN ONE FORT9B: MOVB R2,ERR1 MOV #ERR,R3 ;GET ADDRESS OF JSR PC,ITOA ;DESTINATION AND CONVERT TO ASCII MOV #ENDERR,R5 ;GET COUNT, MOV #ERR,GBUF+6 ;BUFFER ADDRESS, MOV #DESC,R4 ;AND I/O DESCRIPTOR JSR PC,OUTPUT ;GIVE USER THE BAD NEWS FORT9A: CMP #ERRS,ERRCUR ;ASSEMBLY FATA. NEXT CHARACTER CMPB R2,#') ;IS IT A RIGHT PAREN?? BNE IOG10 ;NO, CHECK FOR COMMA JSR R5,OUTCH2 ;OUTPUT A NULL ERR ENTRY '0 IOG11: JSR PC,EOL ;AND AN END OF LINE BR IOG14 ;NOW GO HANDLE THE LIST IOG10: CMPB R2,#', ;IS THERE A COMMA?? BNE IOG09 ;NO MOV #OPTLST,R0 ;CHECK FOR ERR= JSR PC,SCAN2A ; NOW BVS IOG09 ;IT IS NOT THERE TST R0 ;IS IT ERR= ?? BEQ IOG09 ;NO, IS NOT IOG12: JSR R5,OUTCH2 ;SO OUTPUT '. JSR PC,OUTSL ; THE LABEL BVS IOG09 ;ALL IS GOODNESS NOW JSR PC2HRPNT,R3 ;GET CURRENT POINTER CMP R3,#CHREND ;IS THE BUFFER ALREADY FULL? BHIS OUTX04 ;YES OUTX02: MOVB (R4)+,(R3)+ ;STORE A CHARACTER DEC R5 ;DECREMENT COUNT BLE OUTX01 ;UNTIL DONE CMP R3,#CHREND ;IS BUFFER FULL? BLO OUTX02 ;NO OUTX04: MOV R3,CHRPNT JSR PC,OUTFIN ;YES, EMPTY IT BR OUTX03 ;AND CONTINUE OUTX01: MOV R3,CHRPNT ;REMEMBER CURRENT POSITION MOV (SP)+,R3 ;RESTORE R3 RTS PC ;AND RETURN OUTL01: GBUF ;GENERAL BUFFER HEADER LINKOL ;OBJECT LINK BLOCK ; ; OUTLN1 - 1L ERROR? BEQ 3$ ;NO MOV #FATLGT,R5 ;YES - SAY SO MOV #FATASM,GBUF+6 MOV #DESC,R4 JSR PC,OUTPUT 3$: .IF NDF COM8K TSTB RUNFG ;/GO SWITCH SET? BEQ 1$ ;NO TSTB RUNER ;FATAL ERROR FLAG SET? BEQ 2$ ;NO MOV #EXLGT,R5 ;YES, TELL HIM MOV #EXDLT,GBUF+6 ;THAT MOV #DESC,R4 ;EXECUTION JSR PC,OUTPUT ;WAS DELETED BR 1$ 2$: .RLSE #LINKK .RLSE #LINKL .GLOBL TLB,DGBLK .IF DF NOOVL .IFF .RLSE #TLB .ENDC .RLSE #DGBLK JMP RUNLNK ;GO CALL THE LINKER .GLOBL RUNLNK .ENDC3,NXTCH ;GET A CHARACTER CMPB R2,#') ;MAKE SURE IT IS A RIGHT PAREN BEQ IOG11 ;IT IS IOG09: TRAP+71. ;ILLEGAL END= AND/OR ERR= BR IOGERR ;COMMON ERROR EXIT IOG08: JSR R5,OUTCH2 '0 JSR PC,OUTCOM BR IOG12 ; ; GENERATE ADDRESS PUSH FOR VARIABLE ; PVAR: CLRB LSTOUT MOV CURSYM,R0 ;GET ADDRESS OF ENTRY MOV #FMPSH,R4 ;ADDRESS OF PROTOTYPE JSR PC,PUTNAM ;PUT NAME IN LIMBO BIT #PARMKM,PARWD(R0) ;IS IT A PARAMETER????? BEQ PVAR01 ;NO MOV #5 1$: JMP RSET01 ;AND TRY IT ALL AGAIN WKLST: LINKI LINKSL LINKOL .IF NDF COM8K LINKAS .ENDC 0 ; ; RELEASE ANY FILES OPEN WHICH ARE SPECIFIED IN THE LIST ; "WKLST" ; RLSALL: MOV #WKLST,R0 ;GET ADDRESS OF LIST RSET04: MOV (R0)+,R1 ;GET THE LINK BLOCK ADDRESS BEQ RSET06 ;EXIT WHEN DONE TST @R1 ;IS IT INITED? BEQ RSET04 ;NO MOV #RSET05,-2(R1) ;SET THE ERROR RETURN .CLOSE R1 ;AND CLOSE THE THING RSET05: CLR -2(R1) ;CLEAR THE ERROR RET6OUTPUT A LINE WITH A ZERO TERMINATOR, R4 HAS THE STRING ; ADDRESS. ; REGISTERS CHANGED - R4. ; OUTLN1: MOV R5,-(SP) ;SAVE R5 MOV R4,R5 ;GET START OUTL02: TSTB (R5)+ ;COUNT THE CHARACTERS BNE OUTL02 SUB R4,R5 ;COMPUTE DEC R5 ;THE BYTE COUNT JSR PC,OUTLN ;GO OUTPUT THE LINE MOV (SP)+,R5 ;RESTORE R5 RTS PC ;AND RETURN TO CALLER OUTLN2: MOV (R5)+,R4 ;GET ADDRESS OF STRING JSR PC,OUTLN1 ;PRINT IT RTS R5 ; ; ; GENERATE END OF LINE ; EOL:7'P,R4 JSR PC,PUTCHR ;FLAG IT AS A PARAMETER BITB BITM+2,MISC+1 ;DO WE NEED A GLOBL?? BNE PVAR02 ;NO BISB BITM+2,MISC+1 ;YES, SET IT DONE JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ;AND AN END OF LINE PVAR02: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,OUTCOM ;AND A COMMA MOVB PARXWD(R0),R3 ;GET THE PARAMETER INDEX BIC #177400,R3 JSR PC,OUTOCT BR PVAR03 PVAR01: JSR PC,PVX JSR PC,OUTST ;AND THE SYMBOL NAME PVAR03: JSR PC,EOL ;FINALLY AN END OF LINE RTS PC PVX: BITB BITM+1,MISC ; ND.E C ND.E X BET IS.L . = D ENUM S> 12><15//AB 12><15 <12>/OPTIONS = / SWEND = . : JSR R5,OUTLN2 EOL1 RTS PC EOL1: .BYTE 15,12,0 .EVEN ; ; OUTPUT SINGLE CHARACTER IN R4 ; OUTCHR: MOVB R4,CHR JSR R5,OUTLN2 CHR RTS PC CHR: 0 OUTCH2: MOV (R5)+,CHR JSR R5,OUTLN2 CHR RTS R5 .IF NDF COM8K ; ; PAGE HEADER ROUTINE ; .GLOBL PAG,PAGNUM,PNUM,TLGT,LINCT,TITL ; PAG: TST LSTVAL ;MINIMUM LISTING? BEQ PAG02 ;YES, DON'T DO ANY PAGING INC LINCT ;ADVANCE LINE COUNT CMP LINCT,#56. ;DID IT OVERFLOW? BLT PAG02 ;NO MOV R?DO WE NEED A GLOBAL? BNE PVAR04 ;NO BISB BITM+1,MISC ;SET THE DONE BIT JSR PC,OUTGL ;OUTPUT THE GLOBAL JSR PC,EOL ;AND AN END OF LINE PVAR04: JSR PC,OUTNAM ;OUTPUT THE NAME JSR PC,OUTCOM ;AND A COMMA RTS PC ; ; MODE: .BYTE 'B,'L,'I,'R,'D,'C,'X,'A .EVEN OPTLST: OPT1 OPT2 OPTEND 0 OPT1: .ASCII /END=/ OPT2: .ASCII /ERR=/ OPTEND = . .EVEN FMPSH: .ASCII / $PSH/ .BYTE 0 FMTLAB: .BYTE '0 FMTLB1: .BYTE 15,12,0 .EVEN IOG02: P1,P2,P3,P4S LEABUTECEX>/AB<15><1I CIAS . X/XXXX /IISC.A: RECFDE /XXXX/XI CIAS .E:USEC D/ S VETIRALAEC/DB>TA><12><15 /AB<15><1I CIAS . */E*OR C---- -ERILMPCO**>/AB<15><1I CIAS .M:SUOR CX BET ISNL . ;F FT.I X RT PBR T UNCOR TEACARCH ;R5M,SUOR-CNDMESU #OV M ESIN LVEFI ;G PAC, PSR J UT ONTOU;CT NCLI5, #DD AM:SURX PT IF . RNTURED AN ;C PTS R RYMAUM SHE TUTTPOU ;UTTPOUC, PSR J ORPTRISCDEF OSSREDD AET;G4 ,RSCWD#SV MO S ESDRADP UET;S6 F+BU,GUMRSCO #OV M R5+,= .EVEN DESC: GBUF LINKL TITLE: .BYTE '#,13 TEND =.-TITLE .EVEN ERR: .ASCII /0000 ERROR/ ERR1: .ASCII /S/ .BYTE 15,12 ENDERR = .-ERR .EVEN FORT11: .RAD50 /PAL/ FORT12: .RAD50 /LST/ FORT14: .RAD50 /FTN/ .IF NDF COM8K FORT23: .RAD50 /OBJ/ EXDLT: .ASCII /EXECUTION DELETED/<15><12> EXLGT = .-EXDLT .ENDC FATASM: .ASCII /FATAL ERROR IN ASSEMBLY PHASE/<15><12> FATLGT =.-FATASM .LIST BEX .EVEN ; ;CORE SUMMARY ; .GLOBL DECUSE,DECFRE,EXCUSE,>3,-(SP) MOV R4,-(SP) MOV R5,-(SP) INC PAGNUM ;ADVANCE PAGE NUMBER MOV PAGNUM,R4 ;GET PAGE NUMBER MOV #PNUM,R3 ;GET BUFFER ADDRESS JSR PC,ITOA ;CONVERT TO ASCII MOV #PNUM,R3 PAG04: CMPB (R3),#'0 ;IS THIS A LEADING ZERO? BNE PAG03 ;NO, QUIT MOVB #' ,(R3)+ ;BLANK THE CHARACTER BR PAG04 ;AND RE-LOOP PAG03: MOV #TITL,GBUF+6 ;GET ADDRESS OF STRING MOV #TLGT,R5 ;GET COUNT MOV #PAG01,R4 ;GET DESCRIPTOR JSR PC,OUTPUT ;OUTPUT THE LINE CLR LINCT ;RESET LINE COUNT MOV (SP)+,R5 MP)(SV MO OAJTC, PSR J R41, ROV M R3C IN A TO,JPCR JS 3 ,RSECUDE #OV M DSOR WINE ACSPT GE ;4 ,RR1B SU: 2$ ROZEO TFTLEE ACSPT SE, ES;Y R1R CL O ;N 2$O BL ? CEPA SOFT OUN RU ;4 ,RR1P CM S RDWON ;I R1R RO C CL E ACSPD SE UET;G1 ,ROWDLOLB SU H IG HVETIRALAEC DET;G1 ,RGHDHOLV MO N AIAGE AGORSTX MAT GE ;4 ,RR0V MO I CIASO TRTVEON;C OAJTC, PSR J CEPA SEEFRT GE ;4 ,RR1V MO A RE ACEPA SEEFRO TNTOI;P R3C IN I CIASO TRTVEON;C OAJTC, PSR J R3E,USXCEXCFRE,JTOA PRTSUM: .IF NDF COM8K .GLOBL ASMFRE,ASMUSE ADD #4,LINCT ;COUNT OUT JSR PC,PAG ;FOUR LINES .IFTF MOV #ENDASM-CORSUM,R5 ;GET CHARACTER COUNT PRTX: MOV R5,-(SP) MOV LOWCOR,R0 ;GET MAX SUB MTOP,R0 ;AREA SUB #512.,R0 ;TAKE OUT THE MONITOR FUDGE CLC ROR R0 ;HERE MOV R0,R4 MOV FRHIGH,R1 ;GET SUB FRLOW,R1 ;EXECUTABLE CLC ROR R1 ;FREE SPACE CMP R1,R4 ;RUN OUT OF SPACE? BLO 1$ ;NO CLR R1 ;SET FREE SPACE TO ZERO 1$: SUB R1,R4 ;GET USED SPACE IN R4 MOV #EOV (SP)+,R4 MOV (SP)+,R3 PAG02: RTS PC PAG01: GBUF LINKSL .ENDC .END ,P5,P6,P7 P1: .ASCII / $FIND/ .BYTE 0 P2: .ASCII / $INRI/ .BYTE 0 P3: .ASCII / $INI/ .BYTE 0 P4: .ASCII / $INFI/ .BYTE 0 P5: .ASCII / $OUTRI/ .BYTE 0 P6: .ASCII / $OUTI/ .BYTE 0 P7: .ASCII / $OUTFI/ .BYTE 0 P8: .ASCII / $ENCD/ .BYTE 0 P9: .ASCII / $DECD/ .BYTE 0 INIT05: .ASCIZ /0,0/<15><12> .EVEN .END