; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙ASC2 ˙;ASSIGNMENT AND CALL ˙.GLOBL ˙ARYASG,PUTNM1,CURSYM,PARMKM,PARWD,PUTCHR ˙.GLOBL ˙BITM,GL1,OUTGL,EOL,OUTNAM,OUTCOM,PARXWD ˙.GLOBL ˙OUTOCT,OUTST ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙ELOC ˙.GLOBL ˙ELOC ˙.CSECT ELOC ˙= ˙. ˙;ENDING ADDRESS ˙.END ; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙GO008 ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ;WRITTEN BY RON BRENDER ; THIS MODULE CONTAINS - GOTO, ASSIGN, PAUSE, STOP ; ; THE GOTO STATEMENTS ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙ER1008 ;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,SYN2ER,SYNX,ERRS SYNER %7 ; SPACE ˙= ˙40 TAB ˙= ˙11 MODE ˙= ˙60 OP ˙= ˙20 ˙.GLOBL ˙ASGCOM ASGCOM: ˙CLR ˙ARYASG ˙ ˙;TURN OFF ARRAY FLAG HERE ˙MOV ˙#ASGN5,R4 ˙CLR ˙R0 ˙ ˙;SET POINTER TO NORMAL POP ˙JSR ˙PC,PUTNM1 ˙;OUTPUT THE POP PROTOTYPE ˙MOV ˙CURSYM,R4 ˙BIT ˙#PARMKM,PARWD(R4) ;IS THIS A PARAMETER? ˙BEQ ˙ASGN13 ˙ ˙;NO ˙MOVB ˙#'P,R4 ˙ ˙;SET UP PARAMETER ˙JSR ˙PC,PUTCHR ˙; POP ˙MOV ˙#5,R0 ASGN13: ˙MOV ˙R2,R4 ˙ADD ˙#60,R4 ˙ ˙;FOLLOWED BY A ˙JSR ˙PC,PUTCHR ˙;MODE ˙BITB ˙BITM(R2),GL1(R0) ˙;DO WE NEED 7 ˙.GLOBL ˙PUTNAM,BITM,MISC,OUTGL,OUTNAM,OUTCOM ˙.GLOBL ˙OUTCH2,OUTLN2,OUTTAB ˙.GLOBL ˙OUTSL ˙.GLOBL ˙DIMWD,DIMMKM,ASGWD,ASGMKM ˙.GLOBL CHTEST,CURSYM,OUTST,PARXMK,SERMK ˙.GLOBL GENLAB,ZLEQLS ˙.GLOBL PARMKM,PARXMK,OUTOCT,PARWD,SERWD ˙.GLOBL PARXWD,CHKOCT ˙.GLOBL ˙CNXC,OUTLN,OUTLN1,OUTCHR,EOL,OUTSER ˙.GLOBL ˙GOTO,ASSIGN,GET,CNXC1 ;ENTER HERE FOR ALL GOTO STATEMENTS GOTO: ˙JSR ˙PC,CNXC ˙ ˙;FIND NEXT NON-BLANK ˙BEQ ˙GOTOER ˙ ˙;ERROR:END-OF-LINE ˙JSR ˙PC,ZLEQLS ˙;LOOK FOR ZERO LEVEL R: ˙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, PUT 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,-4(R5) ˙;SAME DIAGNOSTIC AS LAST ONE ˙ ˙ ˙ ˙;PUT INTO TABLE? ˙BEQ ˙SYN01 ˙ ˙;IF SO, DON'T ENTER IT, ˙ ˙ ˙ ˙;DON'T UPDATE ERRCUR ˙MOV ˙R4,(R 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 THE COMMA ˙MOV ˙CURSYM,R0 ˙;COMPUTE ˙BIT ˙#PARMKM,PARWD(R0) ;IS IT PARAMETER? ˙BEQ ˙ASGN14 ˙ ˙;NO ˙MOVB ˙PARXWD(R0),R3 ˙;GET THE INDEX ˙JSR ˙PC,OUTOCT ˙;OUTPUT IT ˙BR ˙ASGN11 ASGN14: ˙JSR ˙PC,OUTST ˙;OUTPUT THE NAME ASGN11: ˙JSR ˙PC,EOL ˙ ˙;FOLLOWED BY AN END-OF-LINE ˙RTS ˙PC ASGN5: ˙; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙TI2005 ;ENTRY POINTS .GLOBL ˙ITOA,OUTLN2,OUTCH2 .GLOBL ˙EOL,GETLN,LSTLIN,OUTCHR,OUTLN,OUTLN1,OUTPUT ;EXTERNAL REFERENCES .GLOBL ˙OUTHD,LINKSL,COMHD .GLOBL ˙BUFIN,BUFOUT,CURLN,GBUF,INHD,LGTH,LINE,LINENO .GLOBL ˙LINKI,LINKOL,SEQNO,TLINE ˙.CSE = ˙BCC ˙GOTO03 ˙ ˙;BR => NOT THERE ˙SEV ˙ ˙ ˙;TRY AS ASSIGNMENT INSTEAD ˙RTS ˙PC ; GOTO03: ˙JSR ˙PC,GENLAB ˙;HANDLE THE LABEL NOW ˙CMPB ˙#'(,@R1 ˙BEQ ˙GOTOX ˙ ˙;HAVE COMPUTED GOTO ˙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)+,5)+ ˙;INTO TABLE ˙MOV ˙R5,ERRCUR ˙;SAVE TABLE POINTER SYN01: ˙MOV ˙(SP)+,R5 ˙;RESTORE REGS ˙MOV ˙(SP)+,R4 ˙RTI SYN2ER: ˙CMP ˙ERRCUR,#ERRS ˙;ANY ERRORS? ˙BNE ˙SYNX1 ˙ ˙;YES ˙RTS ˙PC ˙ ˙;NO, RETURN IMMEDIATELY SYNX1: ˙JMP ˙SYNX ˙ ˙;GO OUTPUT THE ERRORS ˙.END .ASCII ˙/ ˙$POP/ ˙.BYTE ˙0 ˙.EVEN ˙.END CT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; TAB ˙= ˙11 ˙ ˙;A TAB HAS THE 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 ; ;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 ˙GOTOU1 ˙ ˙;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 ˙PC,OUTCOM ˙;A COMMA ˙JSR ˙R5,OUTCH2 ˙;AND A . ˙'. ;NOW PUT OUT THE NUMBER, CHECK AS WE GO ˙JSR ˙PC,OUTSL ˙;OUTPUT STATEMENT LABEL FROM SOURCE ˙BVS ˙GO; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙HEAD06 ˙.GLOBL ˙ELOC,BEG,LGT,SCANN,OVJMP,ASF999,TFUNX ˙.CSECT ;OVERLAY 6 HEADER ;WARNING-HEAD01, HEAD02, HEAD06 MUST BE THE SAME LENGTH BEG: ˙. ˙;0-BEGINNING OF OVERLAY LGT: ˙ELOC ˙;2-END OF OVERLAY ˙SCANN ˙;4-START OF STATEMENT SCAN ˙OV GETLN OBTAINS A LINE OF SOURCE INPUT FOR THE COMPILER. ; ˙ANY LINE NUMBERS FOUND ARE STRIPPED AND SAVED. ANY ; ˙CONTINUATIONS 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 ˙#LINE,R1 ˙;SET LINE POINTER TO ZERO ˙TST ˙CURLN ˙ ˙;IS THERE A LINE ALREADY WAITING? ˙BMI ˙GET27 ˙ ˙;EXIT IF END-TOER ˙ ˙;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. ˙ ˙;"ILLEGAL SYNTAX" ; ; NORMAL EXIT FROM THIS MODULE ; GOTONE: ˙JSR ˙PC,EOL ˙ ˙;START HERE FOR NORMAL EXIT ˙CLV ˙ ˙ ˙;DON'T TRY ASSIGNMENT ˙RTS ˙PC ˙RTS ˙PC ; ; SOME TEXT FOR ; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙LST021 ; ;LIST ITEM PROCESSOR FOR SPECIFICATION STATEMENTS, ; ;ALSO, OTHER SPEC. STATEMENT UTILITIES. ; .CSECT .GLOBL ˙LSTX,FILL,GET,CURSYM,T1,T2,T3,T4,T5 .GLOBL ˙T6,T7,T8,T9,T10,T11,T12,T13,T14,T15 .GLOBL ˙T16,T17,T18,T19,T20 .GLOBL ˙DIMMJMP ˙;6-OVERLAY TRANSFER JUMP ˙ASF999 ˙;10-ASF ˙TFUNX ˙;12-TFUN ˙0 ˙;14-NULL ˙0 ˙;16-NULL ˙0 ˙;20-NULL ˙0 ˙;22-NULL ˙.END OF-FILE ˙BEQ ˙GET00 ˙ ˙;NO IF NOT SET ˙MOV ˙CURLN,R5 ˙;PICK UP OLD LINE LENGTH ˙BR ˙GET01 ˙ ˙;AND CONTINUE GET20: ˙JSR ˙PC,LSTL00 ˙;LIST A COMMENT LINE AND TRY AGAIN GET00: ˙JSR ˙PC,INLINE ˙;NO, GET A LINE OF TEXT INTO BUFFER ˙BVS ˙GET26 ˙ ˙˙;EXIT IF EOF OR EOM GET01: ˙CLR ˙CURLN ˙ ˙;TURN OFF BUFFER FLAG ˙MOV ˙#BUFIN,R0 ˙;GET ADDRESS OF BUFFER ˙CMPB ˙@R0,#'C ˙ ˙;IS IT A COMMENT???????????? ˙BEQ ˙GET20 ˙ ˙;YEP, T'IS GET01A: ˙CMPB ˙(R0)+,#SPACE ˙;SKIP ALL SPACES ˙BEQ ˙GET01A ˙ ˙;TO CHECKTHESE GOTOES ; TAB ˙=011 ˙ ˙ ˙;ASCII HORIZONTAL TAB GOTOT0: ˙.BYTE ˙TAB ˙.ASCII ˙"$TR" ˙.BYTE ˙0 ; GOTOT3: ˙.BYTE ˙TAB ˙.ASCII ˙"$TRX" ˙.BYTE ˙0 GOTOT4: ˙.BYTE ˙TAB ˙.ASCII ˙"." ˙.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 COUNKM,DIMWD,PARMKM,PARWD,TYPSIZ,DATYWD,CNXC1 .GLOBL ˙QADX,DIMENS,DATYMM,DATYMK .GLOBL ˙ADBPWD,ADBCUR,MOVE,SYMNXT,SYMBAS .GLOBL ˙TYP,QADBOK,DIMMK,SYMEND,GENLAB .GLOBL ˙EOL,OUTSER,PARXWD,EXPMKM,EXPWD,OUTLN,PARXMK .GLOBL ˙SERWD,SERMK,SERATR,OUTCOM,OUTOCT,OUTTAB,GENLAB ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ;LSTITM ˙ ˙JSR ˙PC,LSTITM ; ;INPUTS:(R1)=1ST CHAR. TO BE SCANNED ; ˙(R2)=LOCATION OF WHERE LSTITM SHOULD PUT ; ˙ ˙AN ADB ;OUTPUTS:(R3)=ADDRESS OF SYMBOL TABLE ENTRY FOR ; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙UTL007 ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ;WRITTEN BY RON BRENDER, DAVE KNIGHT, LOU COHEN ˙.GLOBL ˙OTOA,CKOP,SCAN2A,GENLAB,OUTLN2 ˙.GLOBL ˙OUTCH2,INHLAB,LINENO,SEQNO,HDR,HEAD,HLGT,BLKDAT ˙.GLOBL ˙NXTCH,FILL,CHTEST FOR A BLANK LINE ˙CMPB ˙-(R0),#15 ˙;IS IT FOLLOWED BY A ? ˙BEQ ˙GET20 ˙ ˙;YES, HANDLE LIKE A COMMENT ˙CMPB ˙@R0,#12 ˙ ˙;IS IT A ?? ˙BEQ ˙GET20 ˙ ˙;ALSO A COMMENT ˙CMPB ˙@R0,#14 ˙ ˙; IS ALSO ˙BEQ ˙GET20 ˙ ˙; A COMMENT ˙MOV ˙#BUFIN,R0 ˙JSR ˙PC,GET10 ˙;GO GET A LINE NUMBER ˙MOVB ˙(R0)+,R3 ˙;GET NEXT CHARACTER ˙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, CHECT 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 LABELS 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 ˙TST ITEM IN LIST ; ˙ (R2)=SAME AS INPUT OR 0 IF LIST ITEM NOT ; ˙ ˙DIMENSIONED ; ˙(R1)=CHARACTER WHICH TERMINATED THE SCAN ; ˙Z=0 IF AN ERROR WAS FOUND ; ˙ 1 IF NORMAL. RETURN ;NOTE: ˙INPUT SHOULD BE A LIST ITEM (DELIMITED USUALLY ;BY COMMAS) IN A DECLARATION STATEMENT. ; LSTX: ˙SUB ˙#T16,SP ˙ ˙;SAVE SPACE FOR TEMPS. ˙MOV ˙R1,(SP) ˙ ˙;SAVE R1,R2 IN T1,T2 ˙MOV ˙R2,T2(SP) ˙CLR ˙R3 ˙ ˙;ZERO OUT ADB AREA ˙MOV ˙R2,R4 ˙MOV ˙R4,R5 ˙ADD ˙#5,R5 ˙JSR ˙PC,FILL ˙CLR ˙T9(SP) ˙;CLEAR AREA FOR PO!,GETID,PACK00 ˙.GLOBL ˙CNXC,CNXC1,CHT1 ˙.GLOBL ˙CURSYM,ENTYMM,ENTYWD,EOL,GET,OUTCHR ˙.GLOBL ˙OUTLN,OUTLN1,PUTA,PUTWK,SYMBAS,SYM1WD ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 SPACE=40 ; ; ; ;CHTEST TESTS IF THE BYTE POINTED TO BY R1 IS A LETTER, ; NUMBER, OR OTHER. ;CHT1: ˙DOES THE SAME THING, ON THE CONT. OF R2 ; ˙NOTE: THE CHTEST ENTRY CLOBBERS R2. ; ˙CALL- ˙JSR ˙PC,CHTEST ; ˙INPUT- ˙BYTE IS POINTED TO BY R1 ; ˙OUTPUT- ˙IS IN THE CON"K REST OF LINE ˙MOVB ˙(R0)+,R3 ˙;GET ANOTHER CHARACTER ˙BR ˙GET02 ˙ ˙;AND TRY AGAIN GET26: ˙CMP ˙R1,#LINE ˙;DO WE ALREADY HAVE A LINE?? ˙BEQ ˙GET27 ˙ ˙;NO ˙MOV ˙#-1,CURLN ˙;YES, SET END OF FILE ˙BR ˙GET22 ˙ ˙;AND EXIT GET03: ˙CMP ˙R0,#BUFIN+6 ˙;IS THERE A CONTINUATION ˙BGT ˙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 ˙ #B ˙@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 ˙;GENERATE 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 ˙ ˙$SSIBLE ˙CLR ˙T15(SP) ˙;CLEAR ADJ ARRAY SWITCH ˙ ˙ ˙; ADJ. ARRAY NAME SERIAL # ˙JSR ˙PC,GET ˙ ˙;GET 1ST THING IN LIST ITEM LST02: ˙BVS ˙LST01 ˙ ˙;BR IF TROUBLE OCCURRED ˙TST ˙R3 ˙ ˙;WAS ITEM A SYMBOL? ˙BEQ ˙LST021 ˙;BR IF YES ˙CMP ˙#1,R3 ˙˙;ELSE, WAS ITEM AN ARRAY NAME? ˙BEQ ˙LST021 ˙;BR IF YES ˙BNE ˙LST01 ˙ ˙;BR IF NOT, ERROR. LST021: ˙MOV CURSYM,T6(SP) ;SAVE ADDR OF POTENTIAL ARRAY NAME ˙MOV ˙CURSYM,R2 ˙;SAVE SERIAL # OF ARRAY NAME ˙MOV ˙SERWD(R2),T9(SP) ˙BIC ˙#SERMK,T9(SP) ;IF A%DITION CODES ; ˙N=1 ˙DIGIT ; ˙V=1 ˙LETTER ; ˙C=1 ˙NEITHER DIGIT NOR LETTER ; ˙ONLY 1 CODE WILL BE ON AT ANY RETURN. THUS, C=0 IMPLIES ; ˙EITHER N=1 OR V=1 ; CHTEST: ˙MOVB ˙(R1),R2 CHT1: ˙CMPB ˙R2,#'0 ˙BLO ˙CHT01 ˙;BR IF LESS THAN ALL DIGITS ˙CMPB ˙R2,#'9 ˙BHI ˙CHT02 ˙ ˙;BR IF GTR THAN ALL DIGITS ˙CCC ˙ ˙ ˙;RETURN DIGIT ˙SEN ˙RTS ˙PC CHT01: ˙CCC ˙ ˙ ˙;RETURN NEITHER ˙SEC ˙RTS ˙PC CHT02: ˙CMPB ˙R2,#'A ˙BLO ˙CHT01 ˙ ˙;BR IF LESS THAN ALL LETTERS ˙CMPB ˙R2,#'Z ˙BHI ˙CHT01 ˙ ˙;&˙;WHY??, I DON'T KNOW GET17: ˙CMP ˙#LINE,R1 ˙;CHECK FOR CONTINUATION ON FIRST LINE ˙BNE ˙GET06 ˙ ˙;UNNECESSARY CONTINUATION MARK ˙TRAP+0 ˙ ˙ ˙; IF START OF TEXT BUFFER GET06: ˙CMP ˙#LINE,R1 ˙;IS THIS A CONTINUATION? ˙BEQ ˙GET6A ˙ ˙;NO ˙JSR ˙PC,LSTL00 ˙;YES, DON'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 ˙BEQ ˙GET00 GET15: ˙MOVB ˙R3,(R1)+ ˙;STORE IN LINE BUFFER ˙MOV';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 INTEGER TYPE. ; ; INPUT: CURSYM POINTS TO STE (SET UP BY GETLBV) ; OUTPUT: TO OBJECT DEVICE - CODE TO MOVE VALUE TO STACK ; REGISTE(RRAY NAME IS A PARAMETER =>THIS IS AN ADJSTBLE ARRAY ˙BIT ˙#PARMKM,PARWD(R2) ˙BEQ ˙LST022 ˙;BR IF NOT A PARAMETER ˙INC ˙T15(SP) ˙;ELSE SET ADJ. ARRAY INDICATOR LST022: ˙CMPB ˙(R1),#'( ˙;WAS TEMR. LEFT PAREN? ˙BEQ ˙LST10 ˙ ˙;BR IS YES, DIMENSIONING ˙BR ˙LST11 LST01: ˙TRAP+17. ˙ ˙ ˙;ELSE, SYNTAX NO GOOD. LST010: ˙ADD ˙#T16,SP ˙ ˙;RELEASE TEMPS ˙CLZ ˙ ˙ ˙;Z=0, BAD SYNTAX ˙RTS ˙PC LST11: ˙CLR ˙R2 ˙ ˙;RETURN A SINGLE VARIABLE ˙MOV ˙CURSYM,R3 ˙ADD ˙#T16,SP ˙ ˙;RELEASE TEMPS ˙SEZ ˙RTS ˙)BR IF GTR THAN ALL LETTERS ˙CCC ˙ ˙ ˙;RETURN LETTER ˙SEV ˙RTS ˙PC ; ; ;FILL-- ˙JSR ˙PC,FILL ;INPUTS ˙R3 ˙CONTAINS WORD TO BE FILLED INTO MEMORY ; ˙R4 ˙CONTAINS STARTING ADDR OF FILL AREA ; ˙R5 ˙CONTAINS LAST LOC. TO BE FILLED. ; FILL: ˙CMP ˙R4,R5 ˙ ˙;DONE? ˙BHI ˙FILL01 ˙ ˙;BR IF YES ˙MOV ˙R3,(R4)+ ˙;ELSE FILL A WORD ˙BR ˙FILL FILL01: ˙RTS ˙PC * ˙#LINE,R3 ˙;DID IT ˙ADD ˙#LGTH-1,R3 ˙;OVERFLOW ˙CMP ˙R1,R3 ˙ ˙;HERE?? ˙BGE ˙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 UP POINTER GET08: ˙CMP ˙#LINE,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 NUMBE+RS CHANGED: R0,R2,R3,R4,R5 ; ;TWO CASES: A PARAMETER OR NOT GOVAL: ˙MOV ˙CURSYM,R0 GONOP: ˙JSR ˙PC,OUTTAB ˙MOV ˙CURSYM,R0 ˙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 ˙JSR ˙PC,EOL ˙CMPB ˙#',,(R1)+ ˙BEQ ˙GOLABS ˙ ˙;BACK TO NEXT ONE ˙DEC ˙R1 ˙ ˙;R1 POINTS TO TERMINAL CHAR ˙RTS ˙PC ,PC LST10: ˙;GET UP TO 3 DIMENSIONING ITEMS ;PUT TYPE, SIZE IN ADB ˙MOV ˙T2(SP),R2 ˙;ADB BASE ˙TST ˙(R2)+ ˙;BUMP R2 TO POINT TO WORD 1 ˙MOV ˙T6(SP),R3 ˙;ENTRY BASE,ARRAY NAME ˙MOV ˙DATYWD(R3),R4 ˙MOV ˙R4,(R2) ˙;TYPE INTO ADB ˙SWAB ˙R4 ˙;ISOLATE TYPE ˙ASR ˙R4 ˙ASR ˙R4 ˙ASR ˙R4 ˙;USE AS INDEX INTO SIZE TABLE ˙BIC ˙#177770,R4 ˙MOVB ˙TYPSIZ(R4),(R2) ˙TST ˙(R2)+ ˙;STEP ADB POINTER TO 1ST DIM. WD ˙CLR ˙R4 ˙;DIMENSION=0 ˙MOV ˙R2,R5 ;INITIALIZE PTR TO ADB MODEL FOR HANDLING ;ADJUS-; ; OUTCOL - OUTPUT A COLON ; ˙.GLOBL ˙OUTCOL OUTCOL: ˙MOVB ˙#':,R4 ˙BR ˙OUT ; ; OUTCOM - OUTPUT A COMMA ; ˙.GLOBL ˙OUTCOM OUTCOM: ˙MOVB ˙#',,R4 ˙BR ˙OUT ; ; OUTTAB - OUTPUT A TAB ; ˙.GLOBL ˙OUTTAB TAB ˙= ˙11 OUTTAB: ˙MOVB ˙#TAB,R4 OUT: ˙JSR ˙PC,OUTCHR ˙RTS ˙PC ˙.GLOBL ˙PUTNM1,PUTNAM,PUTCHR,OUTNAM,OUTGL ; ;PUTNAM - PUT NAME IN TEMPORARY PREPARATORY TO OUTPUT. ; PUTNM1: ˙MOV ˙#PUTA,PUTWK ˙;RESET THE POINTER PUTNAM: ˙MOV ˙R5.R ˙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 ˙#LINE,R1 ˙;GET ADDRESS OF BUFFER GET23: ˙RTS ˙PC ˙ ˙;RETURN TO CALLER GET09: ˙TRAP+1 ˙ ˙ ˙;ILLEGAL CONTINUATION MARK, IGNORED ˙BR ˙GET06 ˙ ˙;GO PROCESS LINE ANYWAY GET21: ˙CLR ˙CURLN ˙ ˙;THROW AWAY EXCESS LINE ˙TRAP+6 ˙ ˙ ˙;TELL USER ˙BR ˙GET22 ˙ ˙;AND EXI/ ; ; 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 THE COMMA GOTOA3: ˙CMPB ˙#'(,@R1 ˙ ˙;LOOK FOR LABEL LIST ˙BEQ ˙GOTOA2 ˙ ˙;BR 0TABLE ARRAYSS ˙MOV ˙SP,T13(SP) ˙ADD ˙#T10,T13(SP) ˙MOV ˙T13(SP),T14(SP) ˙;SAVE PTR TO T10 TWICE ˙CLR ˙T10(SP) ˙CLR ˙T11(SP) ˙CLR ˙T12(SP) LST15: ˙JSR ˙PC,CNXC1 ˙;GET NEXT NONBLANK CH. ˙CMP ˙R4,#3 ˙;HAVE WE GOT 3 DIM? ˙BEQ ˙LST23 ˙ ˙;BR IF YES LST16: ˙JSR ˙PC,GET ˙ ˙;NOT YET. GET NEXT THING. LST17: ˙BVS ˙LST26 ˙ ˙;BR IF TROUBLE OCCURRED LST18: ˙TST ˙R3 ˙ ˙;WAS ITEM A SYMBOL ˙BEQ ˙LST50 ˙ ˙;BR IF YES ˙CMP ˙R2,#2 ˙ ˙;1,-(SP) ˙;SAVE R5 ˙MOV ˙PUTWK,R5 ˙;GET ADDRESS OF WORKAREA PUT001: ˙MOVB ˙(R4)+,(R5)+ ˙;STORE A CHARACTER ˙BNE ˙PUT001 ˙ ˙;LOOP UNTIL DONE ˙DEC ˙R5 ˙ ˙;BACK UP OVER NULL ˙MOV ˙R5,PUTWK ˙;REMEMBER POINTER POSITION ˙MOV ˙(SP)+,R5 ˙;RESTORE R5 ˙RTS ˙PC ; ; PUTCHR- PUT A CHARACTER IN THE NAME TEMPORARY ; PUTCHR: ˙MOV ˙R5,-(SP) ˙;GET ˙MOV ˙PUTWK,R5 ˙;THE POSITION POINTER ˙MOVB ˙R4,(R5)+ ˙;STORE THE CHARACTER ˙CLRB ˙@R5 ˙ ˙;SET THE TERMINATOR ˙MOV ˙R5,PUTWK ˙;REMEMBER POSITION ˙MOV ˙(S2T ; ; GET10 - PUT THE ASCII LINE NUMBER IN 3 LOCATIONS AT "LINENO". ; ˙REGISTERS CHANGED - R0,R2,R3,R4. ; GET10: ˙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 ˙BEQ ˙GET11 ˙CMPB ˙R3,#'0 ˙ ˙;IS IT LEGAL ASCII ˙BEQ ˙GET24 ˙ ˙;IGNORE LEADING ZEROS ˙BLT ˙GET13 ˙ ˙;NO ˙CMPB ˙R3,#'9 ˙ ˙;CHECK AGAIN ˙BGT ˙GET13 ˙3=> 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 ) ˙JSR ˙R5,OUTLN2 ˙GOTOT6 4ELSE, WAS IT AN INTEGER? ˙BNE ˙LST26 ˙ ˙;BR IF NO, ILLEGAL ˙TST ˙R0 ˙ ˙;ELSE WAS INT. POS DEF? ˙BLE ˙LST26 ˙ ˙;BR IF NOT LST20: ˙MOV ˙R0,(R5) ˙;ELSE FILL LST201: ˙TST ˙(R5)+ ˙;BUMP ADB POINTER ˙INC ˙R4 ˙ ˙;BUMP DIMENSION COUNTER ˙ADD ˙#2,T13(SP) ˙;BUMP ADB MODEL PTR LST211: ˙CMPB ˙(R1),#', ˙;WAS TERM. A COMMA? ˙BEQ ˙LST15 ˙ ˙;BR IF YES, GET NXT DIM LST23: ˙CMPB ˙(R1),#') ˙;ELSE, WAS TERM A RT PAREN? ˙BNE ˙LST25 ˙ ˙;BR IF NOT ˙INC ˙R1 ˙;STEP PAST RIGHT PAREN ;IF YES, CLOSE OUT LST24: 5P)+,R5 ˙;RESTORE R5 ˙RTS ˙PC ˙ ˙;AND RETURN ; ; OUTNAM - OUTPUT THE STUFF INT EH NAME TEMPORARY ; OUTNAM: ˙MOV ˙#PUTA,R4 ˙;GET THE POINTER ˙MOV ˙R4,PUTWK ˙;RESET THE POINTER ˙JSR ˙PC,OUTLN1 ˙;OUTPUT THE NAME ˙RTS ˙PC ˙ ˙;RETURN ; ; OUTGL - OUTPUT A GLOBAL FROM THE NAME TEMPORARY ; OUTGL: ˙JSR ˙R5,OUTLN2 ˙;GENERATE THE GLOBAL WORD ˙OUTG ˙BR ˙OUTNAM ˙ ˙;NOW THE NAME OUTG: ˙.ASCII ˙/ ˙.GLOBL/ ˙.BYTE ˙0 ; ; ; CKOP - CHECK THE NEXT ONE TO FIVE CHARACTERS UNDER ; ˙SCAN (AS REQUIRED) T6 ˙;NOT LEGAL GET25: ˙MOVB ˙R3,(R4)+ ˙;STORE CHARACTER ˙BR ˙GET11 ˙ ˙;RE-LOOP GET12: ˙CLRB ˙(R4)+ ˙ ˙;TERMINATE LINE NUMBER ˙RTS ˙PC ˙ ˙;AND RETURN 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 GET14: ˙CLR ˙TLINE ˙ ˙;SET NOT FOUND FLAG ˙TRAP+2 ˙ ˙ ˙;GIVE DIAGNOSTIC TO USER GET29: ˙MOVB ˙(R0)+,R3 ˙;SKIP OVER ˙CMPB ˙R3,#TAB ˙ ˙;LINE # FIELD ˙BEQ ˙GET28 ˙CMPB ˙R3,#SPACE ˙BNE ˙GET29 ˙CMPB ˙R7 ˙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 ˙GOTG˙MOV ˙T2(SP),R2 ˙;RESTORE R2, BASE OF ADB ˙ROR ˙R4 ˙;ISOLATE DIMENSION CT, ˙ROR ˙R4 ˙;PUT INTO ADB ˙ROR ˙R4 ˙BIC ˙#037777,R4 ˙;CLEAR SOURCE FIELD ˙BIC ˙#140000,2(R2) ˙;CLEAR DEST. FIELD ˙BIS ˙R4,2(R2) ˙TST ˙T15(SP) ˙;IS THIS AN ADJUSTABLE ARRAY? ˙BEQ ˙LST241 ˙;BR IF NOT ˙JSR ˙PC,GENLAB ˙;ELSE OUTPUT TRACE CODE ˙MOV ˙#LST901-LST899,R5 ˙;OUTPUT GLOBL AND CALL ˙MOV ˙#LST899,R4 ˙;TO $ADJ (ADJ. ARRAY INITIALIZER) ˙JSR ˙PC,OUTLN ˙MOV ˙#LST90A-LST900,R5 ˙MOV ˙#LST900,R4 ˙JSR ˙PC,OUHO DETERMINE IF THEY COMPRISE ; ˙A LEGAL OPERATOR. IF NOT RECOGNIZED, THE POINTER ; ˙IS NOT ADVANCED AND OVERFLOW IS RETURNED. ; ˙IF RECOGNIZED, R1 IS ADVANCED PAST THE OPERATOR, ; ˙THE LOW BYTE OF R0 RETURNS THE PRIORITY AND THE ; ˙HIGH BYTE RETURNS THE OPERATOR IDENTIFIER AS FOLLOWS: ; ; ˙ ˙ID ˙PRIORITY ˙OPERATOR ; ˙ ˙1 ˙0 ˙ .OR. ; ˙ ˙2 ˙1 ˙ .AND. ; ˙ ˙3 ˙2 ˙ .NOT. ; ˙ ˙4 ˙4 ˙ + ; ˙ ˙5 ˙4 ˙ - ; ˙ ˙6 ˙5 ˙ * ; ˙ ˙7 ˙5 ˙ / ; ˙ ˙10 ˙6 ˙ ** ; ˙ ˙11 ˙7 ˙UNARY - ; ˙ ˙12 ˙3 ˙.LT. ; ˙F0,#BUFIN+6 ˙BLOS ˙GET30 ˙MOV ˙#BUFIN+6,R0 GET30: ˙RTS ˙PC GET24: ˙CMP ˙R4,#TLINE ˙;IS THIS A LEADING ZERO?? ˙BEQ ˙GET11 ˙ ˙;YES, IGNORE IT ˙BR ˙GET25 ˙ ˙;NO, STORE IT ; ; INLINE - GETS A LINE OF INPUT. ; ˙R3 RETURNS BYTE COUNT. ; ˙REGISTERS CHANGED - R4,R5. ; INLINE: ˙MOV ˙#INHD,-(SP) ˙;INPUT BUFFER ˙MOV ˙#LINKI,-(SP) ˙;INPUT LINK BLOCK ˙READ ˙ ˙ ˙;DO A READ ˙MOV ˙#LINKI,-(SP) ˙;WAIT ˙MWAIT ˙ ˙ ˙;UNTIL DONE ˙BIT ˙#060000,INHD+2 ˙;CHECK FOR EOF OR EOM ˙BNE ˙INL05 ˙ ˙;EXIT IF SETEOER ; ; SKIP OVER A STATEMENT 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(""Dˆˆˆˆˆˆˆ """""""DDDDDD@DDDD"€ˆˆˆˆˆˆˆ""""@DDDDDDDDDDDDDDDDDDDD """"""€ˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆˆ""""""""""""""""""""""""""DDDDDDDDDDDD€ˆˆˆˆADD€€B B C; Č4d” ›/!Ŕ4d”›6.pÁ4d”›/"VŔ4d”›ˆ~SŔ4d” j›É2Ô4d”› NŸŔ4d”ƒ›l†UŔ4d”'Ŕ›<ŚŔ4d”n)›; ŔÁ4d”… ľ›%˘Ŕ4d”‡:k›ź"ĎŔ4d”š5‰›Ť:4d”Ä"H›\}§Ŕ4d”r› ERROR ˙JSR ˙PC,CNXC ˙ ˙;SET UP 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 ˙JSJ ˙MOV ˙#BUFIN,R2 ˙;GET ˙MOV ˙#BUFOUT,R5 ˙;BUFFER ADDRESSES 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?? ˙BGE ˙INL02 ˙ ˙;NO ˙CMPB ˙R4,#15 ˙ ˙; IS SPECIAL ˙BEQ ˙INL02 ˙CMPB ˙R4,#12 ˙ ˙; IS MORE SPECIAL ˙BEQ ˙INL04 ˙CMPB ˙R4,#14 ˙ ˙;A IS SPECIAL TOO ˙BEQ ˙INL04 ˙CMPB ˙R4,#TAB ˙BEQ ˙INL02 ˙MOVB ˙#'^,(R5)+ ˙;STORE ^ ˙ADD ˙#100,R4 ˙ ˙;CONVERT TO UPPER CASE KTLN ˙JSR ˙PC,OUTCOM ˙MOV ˙T9(SP),R3 ˙;GET SERIAL # OF ARRAY NAME ;NOTE - SER. # OF ARRAY NAME PREFIXED WITH "$A" ;IS THE SYMBOL FOR THE ARRAY'S ADB AT OBJECT TIME ˙MOVB ˙#'A,R0 ˙;OUTPUT SYMBOLIC NAME OF ADB ˙JSR ˙PC,OUTSER ˙JSR ˙PC,OUTCOM ˙;WRITE A COMMA ;NEXT GET THE PARAMETER INDEX OF THE ARRAY NAME ;AND OUTPUT IT TO THE OBJECT DEVICE. ˙MOV ˙T6(SP),R3 ˙;WE CAN ASSUME THAT THE ˙MOV ˙PARXWD(R3),R3 ˙;ARRAY NAME IS INDEED A ˙BIC ˙#PARXMK,R3 ˙;PARAMETER SINCE IT WAS ˙JSR ˙PC,OUTOCT ˙;CHL ˙13 ˙3 ˙.GT ; ˙ ˙14 ˙3 ˙.EQ. ; ˙ ˙15 ˙3 ˙.NE. ; ˙ ˙16 ˙3 ˙.LE. ; ˙ ˙17 ˙3 ˙.GE. ; ; ˙THE UNARY MINUS IS NOT RECOGNIZED BY THIS ROUTINE ; ˙BECAUSE IT IS CONTEXT SENSITIVE. IT HAS AN ID OF 11 ; ˙AND A PRIORITY OF 6. ; ; ˙REGISTERS CHANGED - R0,R1,R2,R3; CKOP: ˙MOV ˙#CKPLST,R0 ˙;GET ADDRESS OF OPERAND TABLE ˙JSR ˙PC,SCAN2A ˙;GO FIND AN OPERATOR ˙BVS ˙CKOP01 ˙ ˙;NO SUCH LUCK ˙MOV ˙CKPVAL(R0),R0 ˙;GET OPERATOR AND PRIORITY CKOP01: ˙RTS ˙PC ˙ ˙;AND RETURN ˙.GLOBL ˙LOGREL ; ; OPERATOR PROMR ˙PC,SKPSL ˙;SKIP OVER LABEL ˙JSR ˙PC,CNXC ˙ ˙;LOOK FOR "T0" ˙CMPB ˙#'T,(R1)+ ˙; ˙BNE ˙ASSIER ˙JSR ˙PC,CNXC ˙CMPB ˙#'O,(R1)+ ˙BEQ ˙ASSI01 ; ; 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 PARANINL02: ˙MOVB ˙R4,(R5)+ ˙;STORE IN BUFFER ˙BR ˙INL01 INL04A: ˙MOVB ˙#15,(R5)+ ˙;FORCE END OF LINE ˙MOVB ˙#12,R4 ˙MOV ˙#15,(R2)+ ˙;CLEAR END ˙MOV ˙R4,(R2)+ ˙;OF INBUF TOO!! INL04: ˙MOVB ˙R4,(R5)+ ˙;STORE ˙SUB ˙#BUFOUT,R5 ˙;GET BYTE COUNT ˙RTS ˙PC ˙ ˙;AND RETURN INL05: ˙SEV ˙ ˙ ˙;SET EOF/M FLAG ˙RTS ˙PC ˙ ˙;AND RETURN ; ; 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 ˙MOOECKED FOR AT LST502: ˙MOV ˙#3,R5 ˙;INITIALIZE LOOP COUNT ˙MOV ˙T14(SP),R4 ˙;GET ADDR OF ADB MODEL LST243: ˙MOV ˙R4,-(SP) ˙;PROTECT R4 FROM "OUTCOM" ˙JSR ˙PC,OUTCOM ˙;OUTPUT A COMMA ˙MOV ˙(SP)+,R4 ˙;GET R4 BACK ˙MOV ˙(R4)+,R0 ˙;GET SERIAL # OF NEXT DIM. ˙BEQ ˙LST242 ˙;IF 0 ISSUE A "-1" ˙MOV ˙R4,-(SP) ˙;PROTECT R4 ˙JSR ˙PC,SERATR ˙;ELSE GET PARAMETER FROM SYMBOL TABLE ˙MOV ˙CURSYM,R0 ˙MOV ˙PARXWD(R0),R3 ˙;GET RID OF UNWANTED BITS ˙BIC ˙#PARXMK,R3 ˙JSR ˙PC,OUTOCT ˙;CONVERT TO ASCII &PTOTYPE TABLE ; CKPLST: ˙CK0 ˙CK1 ˙CK2 ˙CK3 ˙CK4 LOGREL: ˙CK5 ˙CK6 ˙CK7 ˙CK8 ˙CK9 ˙CK10 ˙CK11 ˙CK12 ˙CK13 ˙CK14 ˙0 ; CK0: ˙.BYTE ˙'+ CK1: ˙.BYTE ˙'- CK2: ˙.BYTE ˙'*,'* CK3: ˙.BYTE ˙'* CK4: ˙.BYTE ˙'/ CK5: ˙.ASCII ˙˙/.OR./ CK6: ˙.ASCII ˙/.AND./ CK7: ˙.ASCII ˙/.NOT./ CK8: ˙.ASCII ˙/.LT./ CK9: ˙.ASCII ˙/.GT./ CK10: ˙.ASCII ˙/.EQ./ CK11: ˙.ASCII ˙/.NE./ CK12: ˙.ASCII ˙/.LE./ CK13: ˙.ASCII ˙/.GE./ CK14 ˙= ˙. ˙.EVEN ; ; FOLLOWING TABLE CONTAINS THE OPERATOR PRIOQMETER 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 ; ; 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 ˙RV ˙NBUF+4,NBUF+2 ˙BR ˙LSTL03 LSTLIN: ˙MOV ˙R5,-(SP) ˙MOV ˙R3,-(SP) ˙;SAVE R3 ˙MOV ˙SEQNO,R4 ˙;GET THE SEQUENCE NUMBER ˙MOV ˙#NBUF,R3 ˙;AND THE BUFFER ADDRESS ˙JSR ˙PC,ITOA ˙ ˙;CONVERT TO INTEGER ˙MOV ˙(SP)+,R3 LSTL03: ˙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 ˙INC ˙R5 ˙ ˙;ALLOW POINTER TO INCLUDE ";" ˙MOV ˙#LSTL02,R4 ˙;DESCRS WRITE OUT ˙MOV ˙(SP)+,R4 ˙;GET R4 BACK LST245: ˙DEC ˙R5 ˙;REDUCE LOOP COUNT ˙BNE ˙LST243 LST244: ˙JSR ˙PC,EOL ˙;WRITE ˙MOV ˙T2(SP),R2 ˙;RESTPRE ADB PTR TO R2 LST241: ˙MOV ˙T6(SP),R3 ˙;DELIVER CUR. SYMBOL ˙MOV ˙R3,CURSYM ˙ADD ˙#T16,SP ˙ ˙;RELEASE TEMPS. ˙SEZ ˙ ˙ ˙;Z=1 ˙RTS ˙PC LST26: ˙TRAP+16. ;DIAG "ILLEGAL SYNTAX IN DIM. SPEC." ˙MOV ˙#1,(R5) ˙;DEFAULT DIMENSION SIZE=1 ˙BR ˙LST201 LST25: ˙TRAP+110. ;DIAG, "DIMENS. NOT TERM BY RIGHT PARAN". ˙MOV ˙T2(SP),R2 ˙;RESTORE R2 ˙TRITY ; ˙FOLLOWED BY ITS INTERNAL NAME IN ORDERED PAIRS. ; ˙.GLOBL ˙PLUS,MINUS,PWR,MUL,DIV,OR,AND,NOT ˙.GLOBL ˙LT,GT,EQ,NE,LE,GE CKPVAL:PLUS: ˙.BYTE ˙4,4 MINUS: ˙.BYTE ˙4,5 PWR: ˙.BYTE ˙6,10 MUL: ˙.BYTE ˙5,6 DIV: ˙.BYTE ˙5,7 OR: ˙.BYTE ˙0,1 AND: ˙.BYTE ˙1,2 NOT: ˙.BYTE ˙2,3 LT: ˙.BYTE ˙3,12 GT: ˙.BYTE ˙3,13 EQ: ˙.BYTE ˙3,14 NE: ˙.BYTE ˙3,15 LE: ˙.BYTE ˙3,16 GE: ˙.BYTE ˙3,17 ; ; ; ; ˙CALL ˙JSR ˙PC,GETID ;GETID ˙(R1)=UMOV ˙#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 ASSIG4: ˙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,OUTCOM ˙;OUTPUT A COMMA ˙MOV ˙CURSYM,R0 ˙;SYMBOL TABLE ENTRY ADDRESS ˙JMP ˙VIPTION OF OBJECT OUTPUT ˙JSR ˙PC,OUTPUT ˙;OUTPUT THE LINE ˙RTS ˙PC ˙ ˙;AND RETURN 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. NBUF: ˙.ASCII ˙/0000 / ˙.EVEN ; ; ITOA - INPUT IN R4 CONVERTED TO ASCII IN R3 LIST ; ITOA: ˙MOV ˙#ITA03,R5 ˙;GET POINTER TO FUDGES ITA01: ˙MOVB ˙#57,@R3 ˙ ˙;SET UP DIVIDEND FUDGE ITA02: ˙INCB ˙@R3 ˙ ˙;INCREMENT COUNWMOV ˙T6(SP),R3 ˙;FIX UP CURSYM ˙MOV ˙R3,CURSYM ˙ADD ˙#T16,SP ˙ ˙;RELEASE TEMPS ˙CLZ ˙RTS ˙PC LST242: ˙MOV ˙#-1,R3 ˙;OUTPUT A -1 ˙MOV ˙R4,-(SP) ˙JSR ˙PC,OUTOCT ˙MOV ˙(SP)+,R4 ˙BR ˙LST245 ;HANDLE ADJUSTABLE ARRAY ITEM LST50: LST501: ˙CLR ˙(R5) ˙ ˙;SET NEXT ADB DIM=0 LST502: ˙MOV ˙CURSYM,R3 ˙;IS THIS ITEM A PARAMETER? ˙BIT ˙#PARMKM,PARWD(R3) ˙BEQ ˙LST504 ˙ ˙;BR IF NOT ˙MOV ˙T6(SP),R3 ˙;ELSE IS ARRAY NAME A PARAM? ˙BIT ˙#PARMKM,PARWD(R3) ˙BEQ ˙LST504 ˙;BR IF NOT, ERROR ;ELSE XINPUT, POST INCREMENTED AFTER EACH MOVE ; ˙(R5)=OUTPUT, POINTING TO THE TERM. 0-BYTE ON RETURN. ; ˙R4 CLOBBERED ; ˙GETS UP TO 6 CH, STOPS ON A NON-DIGIT/NON-LETTER ; ˙APPENDS A 0 BYTE TO THE OUTPUT STRING GETID: ˙MOV ˙#6,R4 ˙JSR ˙PC,CHTEST ˙;IS 1ST CH A LETTER ˙BVC ˙GETI03 ˙ ˙;BR IF NOT GETI02: ˙MOVB ˙@R1,(R5)+ ˙;MOVE CH TO OUTPUT ˙JSR ˙PC,CNXC1 ˙;GET NXT CH ˙JSR ˙PC,CHTEST ˙;IS IT A DELIMITER? ˙BCS ˙GETI01 ˙ ˙;BR IF YES ˙DEC ˙R4 ˙;REDUCE LOOP COUNT ˙BNE ˙GETI02 ˙ ˙;BR IF NO, ELSE FALLY@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 ˙;OUTPUT 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: ˙.BYTZT ˙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: ˙1750 ˙ ˙;1,000 ˙144 ˙ ˙;100 ˙12 ˙ ˙;10 ˙1 ˙ ˙;1 ˙0 ˙ ˙;TERMINATOR ; ; 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 ;[DEPOSIT SERIAL # OF THIS ITEM IN MODEL ADB ˙MOV ˙CURSYM,R3 ˙MOV ˙SERWD(R3),@T13(SP) ˙BIC ˙#SERMK,@T13(SP) ˙INC ˙T15(SP) ˙;SET ADJ ARRAY SW TO NON 0 ˙JMP ˙LST201 LST504: ˙TRAP+22. ;DIAG: "ADJ. ARRAY NAME OR INDX ITEM MUST BE PARAM" ˙JMP ˙LST201 ˙ ˙;THEN, GO ON ; LST899: ˙.ASCII ˙/ ˙.GLOBL/ LST900: ˙.ASCII ˙/ ˙$ADJ/ LST90A: ˙.BYTE ˙015,012 ˙; LST901=. ˙.EVEN ; ; ;DIMENS ˙ ˙DIMENSION STATEMENT PROCESSOR ; ; DIME\ THROUGH. GETI01: ˙CLRB ˙(R5) ˙ ˙;DROP A 0 INTO OUTPUT ˙CLV ˙RTS ˙PC GETI03: ˙SEV ˙RTS ˙PC ; ; ˙MOD40 PACK - ENTERED WITH JSR PC, PACK00 ; ; ˙INPUT: ˙ ˙R0=ADR OF MOD40 WORDS (2 WORDS) ; ˙ ˙R1=ADR OF ASCII CHARACTERS (6 CHARS) ; ; ˙OUTPUT: ˙ ˙R1 POINTS ONE PAST END OF ASCII STRINT ; ˙ ˙THE MOD40 WORD IS FORMED AS ; ˙ ˙N=C1*40^2+C2*40+C3 ; ; ˙R2,R3,R4,R5 ARE CLOBBERED PACK00: ˙ ˙MOV#-2,R5 ˙;MAJOR LOOP COUNT PACK01: ˙MOV ]E ˙',,'.,0 ˙ ˙;HI THERE, LISTING READER ˙.EVEN ; ; ˙PAUSE AND STOP STATEMENTS ; ; ˙ALLOWED FORMS: ; ˙ PAUSE O123456 ˙;OCTAL NUMBER ; ˙ PAUSE 177777 ˙ ˙;IMPLIED OCTAL ; ˙ PAUSE Z12AF ˙;HEX NUMBER ; ˙ PAUSE 'TEXT''TOO' ˙;TEXT STRING ; ; ; ˙ STOP O1234 ; ˙ STOP 123456 ; ˙ STOP Z12AF ; ˙ STOP 'TEXT''TOO' ; ; ˙.GLOBL CNXC,PAUSE,STOP,OUTLN,OUTLN1,OUTCHR,EOL ˙.GLOBL PAUSSP ˙;A TEMPORARY SAVE WORD ^ ˙DESIRED BUFFER HEADER, THE SECOND OF WHICH IS THE ; ˙CORRESPONDING LINK BLOCK ADDRESS. ; ˙REGISTERS CHANGED - R4,R5. ; OUTPUT: ˙MOV ˙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 ˙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 OUTPUT ON THE OBJECT DEVICE? ˙BNE ˙OUT001 ˙ ˙;NO,IGNORE IT_NS: ˙TSTB ˙ALOKAT ˙.GLOBL ˙ALOKAT ˙BNE ˙DIMERR ˙SUB ˙#T15,SP ˙;RESERVE TEMPS ˙MOV ˙#1,T3(SP) ˙;SET ENTRY SW. TO "DIMENSION" ˙BR ˙DIM01 DIMERR: ˙TRAP+108. ˙;CAN'T OCCUR AFTER DATA ˙RTS ˙PC ; ; ; ;TYPE PROCESSOR--SHARES COMMON CODE WITH ;"DIMENSION" ;ON ENTRY THE EXPLICIT DATA TYPE MUST BE IN THE ;LOW ORDER 3 BITS OF R0 ; ; TYP: ˙TSTB ˙ALOKAT ˙BNE ˙DIMERR ˙SUB ˙#T15,SP ˙ ˙;RESERVE SOME TEMPS ˙CLR ˙T3(SP) ˙ ˙;SET ENTRY SW TO "TYPE" DIM01: ˙MOV ˙R4,(SP) ˙MOV ˙R5,T2(SP) ˙MOV`˙#-3,R4 ˙ ˙;MINOR LOOP CT. ˙CLR ˙R2 ˙ ˙;0 SUM PACK05: ˙MOVB ˙(R1)+,R3 ˙ ˙;GET NEXT ASCII CHAR. ˙BNE ˙PACK06 ˙DEC ˙R1 ˙ ˙;A ZERO TERMINATOR ˙BR ˙PACK07 ˙ ˙;IMPLIES BLANK FILL PACK06: ˙CMPB ˙#' ,R3 ˙BEQ ˙PACK02 ˙ ˙;"BLANK" ˙CMPB ˙#'$,R3 ˙BEQ ˙PACK04 ˙ ˙;"$" ˙CMPB ˙R3,#'A ˙BLO ˙PACK03 ˙ ˙;"." OR "0-9" ˙SUB ˙#40,R3 ˙ ˙;"A-1" PACK02:SUB ˙#16,R3 PACK03:SUB ˙#11,R3 PACK04:SUB ˙#11,R3 ; ˙MULT R2 BY 40. PACK07: ˙ASL ˙R2 ˙ ˙;2*R2 ˙ASL ˙R2 ˙ ˙;4*R2 ˙ASL ˙R2 ˙ ˙;8*R2 ˙MOV ˙R2,-(SP) ˙ a ˙.GLOBL GENLAB,ZLEQLS STOP: ˙MOV ˙#STOTXT,R4 ˙;INITIAL TEXT FOR STOP ˙BR ˙PAUSF PAUSE: ˙MOV ˙#PAUTXT,R4 ˙;TEXT FOR PAUSE LINE PAUSF: ˙JSR ˙PC,CNXC ˙ ˙;LOCATE NEXT NON-BLANK ˙MOVB ˙(R1),R2 ˙ ˙;LOOK AT FIRST CHAR ˙CMPB ˙#'',R2 ˙ ˙;LOOK FOR ASCII CASE ˙BEQ ˙PAUSE2 ˙ ˙;YES - ASCII ;BEFORE CHECKING OTHER CASES LOOK FOR ; ZERO LEVEL EQUAL SIGN - IF FOUND, SET V-BIT AND EXIT ˙JSR ˙PC,ZLEQLS ˙;LOOK ˙BCC ˙PAUSEY ˙ ˙;BR => NOT FOUND: ASSUME PAb ˙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 ˙MWAIT ˙ ˙ ˙;WAIT FOR COMPLETION OUT1: ˙MOV ˙(SP)+,R3 ˙;RESTORE R3 ˙RTS ˙PC OUTNO: ˙TST ˙(SP)+ ˙ ˙;DISCARD ELEMENT ON STACK ˙BR c ˙R0,T4(SP) ˙;PUT ACTUAL TYPE IN T4 ˙MOV ˙R1,T5(SP) ;SAVE START OF STRING IN CASE ˙ ˙ ˙ ˙;OF ERROR ˙MOV ˙SP,R2 ˙ ˙;COMPUTE ADDR OF ADB WORK AREA, ˙ ˙;T6-T10 ˙ADD ˙#T6,R2 ˙MOV ˙R2,T11(SP) ˙;SAVE ADDR OF ADB WRK AREA KER01: ˙JSR ˙PC,LSTX ˙;LOOK AT NEXT LIST ITEM ˙BNE ˙KER13 ˙ ˙;WAS IT OK? BR IF NOT KER03: ˙TST ˙R2 ˙ ˙;ELSE WAS ITEM PREV. DIM'D? ˙BEQ ˙KER09 ˙ ˙;BR IF NOT ;ELSE IF THIS IS "TYPE" PROCESSING - OVERRIDE ;SIZE & TYPE IN ADB. ˙TST ˙T3(SP) ˙ ˙;IS THIS "TYPE" PROC. ˙BNE ˙KER0d˙;STACK 8*R2 ˙ASL ˙R2 ˙ ˙;16.*R2 ˙ASL ˙R2 ˙ ˙;32.*R2 ˙ADD ˙(SP)+,R2 ˙;40.*R2 ; ˙INCLUDE CURRENT CHARACTER ˙ADD ˙R3,R2 ˙INC ˙R4 ˙ ˙;DONE 3 CHARS? ˙BLT ˙PACK05 ˙ ˙;NO ˙MOV ˙R2,(R0)+ ˙;YES-STORE MOD40 WORD ˙INC ˙R5 ˙;DONE 2 WORDS? ˙BLT ˙PACK01 ˙;NO ˙RTS ˙PC ˙ ˙;EXIT ; ; NXTCH - GET THE NEXT NON-BLANK CHARACTER IN THE R1 STRING ; ˙INTO R2. REGISTERS CHANGED - R1,R2. ; NXTCH: ˙MOVB ˙(R1)+,R2 ˙;GET A CHARACTER ˙CMPB ˙#SeUSE ˙SEV ˙ ˙ ˙;REQUEST ATTEMPT AS ASSIGNMENT ˙RTS ˙PC ; PAUSEY: ˙MOV ˙SP,PAUSSP ˙;SAVE SP FOR LATER RECOVERY ˙CMPB ˙#'O,R2 ˙ ˙;LOOK FOR OCTAL ˙BEQ ˙PAUSE0 ˙ ˙;BR => OCTAL ˙CMPB ˙#'Z,R2 ˙ ˙;LOOK FOR HEX ˙BEQ ˙PAUSE1 ˙ ˙;YES,HEX ˙TST ˙R2 ˙ ˙;IS IT THE SIMPLE FORM? ˙BNE ˙PAUSEZ ˙ ˙;NO-ASSUME OCTAL AND HOPE ˙JSR ˙PC,GENLAB ˙;YES ˙JSR ˙PC,OUTLN1 ˙;OUTPUT A ˙MOV ˙#PAUST1,R4 ˙; DUMMY ˙BR ˙PAUSE4 ˙; STRING ; ; DOES NOT FIT SYNTAX OF PAUSE OR STOP ; PAUSEX: ˙TRAP+50. ˙ ˙ ˙;"ILLEGAL f˙OUT1 ; ; OUTLN - OUTPUT A LINE OF ASCII TO THE OBJECT DEVICE. R4 HAS ; ˙ADDRESS OF THE STRING, R5 HAS THE COUNT. ; ˙REGISTERS CHANGED - R4,R5. ; OUTLN: ˙MOV ˙R4,GBUF+6 ˙;SET UP THE ADDRESS ˙MOV ˙#OUTL01,R4 ˙;GET ADDRESS OF I/O DESCRIPTOR ˙˙JSR ˙PC,OUTPUT ˙;OUTPUT THE LINE ˙RTS ˙PC ˙ ˙;AND RETURN OUTL01: ˙GBUF ˙ ˙ ˙;GENERAL BUFFER HEADER ˙LINKOL ˙ ˙ ˙;OBJECT LINK BLOCK ; ; OUTLN1 - OUTPUT A LINE WITH A ZERO TERMINATOR, R4 HAS THE STRING ; ˙ADDRESS. ; ˙REGISTERS CHANGED - R4. ; OUTLN1g4 ˙ ˙;BR IF NOT ˙TST ˙R2 ˙ ˙;WAS THERE AN ADB? ˙BEQ ˙KER04 ˙ ˙;BR IF NOT ˙MOV ˙T4(SP),R4 ˙;ELSE GET CORRECT SIZE ˙MOVB ˙TYPSIZ(R4),2(R2) ; ˙SWAB ˙R4 ˙ ˙;MANUEVER TYPE ˙ASL ˙R4 ˙ASL ˙R4 ˙ASL ˙R4 ˙BIC ˙#DATYMK,R4 ˙;INTO ADB ˙BIC ˙#DATYMM,2(R2) ˙BIS ˙R4,2(R2) KER04: ˙JSR ˙PC,QADX ;IF DIM'D, CHK NEW AND OLD ADB'S KER05: ˙BVS ˙KER08 ˙ ˙;BR IF NOT SAME KER06: ;ADB WAS ATTACHED TO SYMBOL TABLE ENTRY ˙;ON NORMAL EXIT FROM QADBOK (V=0) KER09: ˙TST ˙T3(SP) ˙ ˙;IS THIS A "TYPE" STATEMENT?hPACE,R2 ˙;SKIP ˙BEQ ˙NXTCH ˙ ˙; BLANKS ˙RTS ˙PC ˙ ˙;RETURN WITH ANY NON-BLANK CHARACTER. ; ;CNXC: ˙INPUT (R1)=CURRENT CHARACTER POINTER ; ˙OUTPUT: (R1)=NEXT NON BLANK CHAR. OR SAME AS ;INPUT, IF INPUT WAS NON BLANK ; ˙OUTPUT: CONDITION CODES ARE SET BY ; A TSTB ON THE OUTPUT CHAR. ;CNXC1: ˙SAME AS CNXC EXCEPT R1 IS BUMPED FIRST. CNXC: ˙CMPB ˙#' ,@R1 ˙BEQ ˙CNXC1 ˙TSTB ˙@R1 ˙RTS ˙PC CNXC1: ˙INC ˙R1 ˙BR ˙CNXC ; ; OTOA - OiCONSTANT IN PAUSE/STOP" ˙JSR ˙PC,EOL ˙MOV ˙PAUSSP,SP ˙;FIXUP SP ˙CLV ˙ ˙ ˙;DON'T TRY ASSIGNMENT ˙RTS ˙PC ; ; COME HERE TO CLOSE OFF A NORMAL (AND CORRECT) ; OUTPUT LINE BY APPENDING THE CLOSING ' (PRIME) ; AND TERMINATING ".BYTE 0" AND ".EVEN" ; PAUSE3: ˙MOV ˙#PAUST5,R4 ˙;POINTER TO THE TEXT PAUSE4: ˙JSR ˙PC,OUTLN1 ˙;TO BINARY ˙CLV ˙ ˙ ˙;EXIT HAPPY ˙RTS ˙PC ; ; ASSUMED OCTAL CASE (NO INITIAL "O") ; PAUSEZ: ˙DEj: ˙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: ˙JSR ˙R5,OUTLN2 ˙EOL1 ˙RTS ˙PC EOL1: ˙.BYTE ˙15,12,0 ˙.EVEN ; ; OUTPUT SINGLE CHARACTER IN R4 ; k ˙BNE ˙KER50 ˙ ˙;BR IF NOT, DIMENSION STATEMENT KER092: ˙BIC ˙#DATYMM,DATYWD(R3) ;PUT TYPE INTO SYM TBL ENTRY ˙MOV ˙T4(SP),R4 ˙CCC ˙SWAB ˙R4 ˙ASL ˙R4 ˙ASL ˙R4 ˙ASL ˙R4 ˙BIC ˙#DATYMK,R4 ˙BIS ˙R4,DATYWD(R3) ˙BIS ˙#EXPMKM,EXPWD(R3) ;SET "EXPLICITLY TYPED" BIT KER11: ˙TSTB ˙(R1) ˙BEQ ˙KER15 ˙ ˙;ZERO, END OF LINE KER13: ˙JSR ˙PC,CNXC1 ˙;GET NEXT NON-BLANK CH. ˙TSTB ˙(R1) ˙ ˙;CHECK END-OF LINE ˙BEQ ˙KER15 ˙CMPB ˙(R1),#', ˙;IF A COMMA, GET ANOTHER CHARACTER ˙BEQ ˙KER13 ˙MOV ˙T1lCTAL IN R3 CONVERTED TO ASCII ; ˙STRING POINTED TO BY R2 ; ˙REGISTERS CHANGED - R2,R3,R4. ; OTOA: ˙MOV ˙#2230,R4 ˙;SET LP CNT & 1ST DIG. BITS OTOA01: ˙ASL ˙R3 ˙ ˙;GET A BIT ˙ROLB ˙R4 ˙ ˙;MOVE INTO ASCII DIGIT ˙BCC ˙OTOA01 ˙ ˙;MARKER YET? ˙MOVB ˙R4,(R2)+ ˙ ˙;IF SO STORE CHARACTER ˙CLRB ˙R4 ˙ ˙;RESET MARKER ˙BISB ˙#23,R4 ˙ ˙;AND RESET ASCII BITS ˙ASL ˙R4 ˙ ˙;6 DIGITS DONE?? ˙BCC ˙OTOA01 ˙ ˙;NO ˙RTS ˙PC ˙ ˙;YES - EXIT ; ;mC ˙R1 ˙ ˙;BACK UP R1 TO LEAVE FULL CONSTANT ; ; OCTAL CONSTANT CASE ; PAUSE0: ˙JSR ˙PC,PAUSE6 ˙;INITIAL TEXT OUT ˙MOV ˙#CHKOCT,R3 ˙;OCTAL CHECK ROUTINE ˙MOV ˙#7,R0 ˙ ˙;AT MOST 6 CHARS IN OCTAL CONST ˙JSR ˙PC,PAUS01 ˙;OUTPUT OCTAL CONST AS TEXT ˙CMP ˙#1,R0 ˙ ˙;EXACTLY SIX CHARS? ˙BNE ˙PAUSE3 ˙ ˙;NO - ALL IS WELL ;IF SIX CHAR THEN FIRST MUST BE 0 OR 1 ˙CMPB ˙#'1,R2 ˙BGT ˙PAUSEX ˙ ˙;TOO BIG IS AN ERROR ˙BR ˙PAUSE3 ˙ ˙;ALLS WELL THAT ENDS WELL! ; ; OUTPUT OCTAL AND HEX CONSTANTS AS OUTCHR: ˙MOVB ˙R4,CHR ˙JSR ˙R5,OUTLN2 ˙CHR ˙RTS ˙PC CHR: ˙0 OUTCH2: ˙MOV ˙(R5)+,CHR ˙JSR ˙R5,OUTLN2 ˙CHR ˙RTS ˙R5 ˙.END o1(SP),R2 ˙;BRING BACK PTR TO ADB AREA ˙BR ˙KER01 KER50: ˙TST ˙R2 ˙;TEST FOR DIMENSIONING AGAIN ˙BNE ˙KER11 ˙;BR IF DIM'D. ELSE ERROR-- ˙TRAP+27. ˙;DIAG:"DIMENSION STATEMENT LIST ITEM LACKS ˙;DIMENSIONING ELEMENTS" ˙BR ˙KER11 KER15: ˙MOV ˙˙(SP),R4 ˙ ˙;NORMAL EXIT-TYPE,DIM ˙MOV ˙T2(SP),R5 ˙ADD ˙#T15,SP ˙;RELEASE TEMPORARIES ˙CLV ˙RTS ˙PC KER08: ˙TRAP+30. ˙;DIAG:"CONFLICTING DIMENSIONING ˙ ˙;SPECIFIED IN AN EARLIER STATEMENT" ˙BR ˙KER09 ; ; ; ; ; ; ;QADBOK ; ;INPUT ˙(R2)=Ap SCAN2A - SUB. TO COMPARE CH. STRING SUPPLIED WITH POINTER ; ˙IN R1, WITH A PROTOTYPE LIST POINTED TO BY R0. ; ˙UPON RETURN, IF SUCCESSFUL, R0 CONTAINS AN INDEX ; ˙INTO A WORD-LENGTH LIST CORRESPONDING TO THE STRING ; ˙FOUND. ; ˙IF UNSUCCESSFUL, R1 IS LEFT UNCHANGED AND THE V-BIT IS ; ˙SET. ; ˙REGISTERS CHANGED - R0,R1,R2,R3. ; SCAN2A: ˙MOV ˙R4,-(SP) ˙MOV ˙R5,-(SP) ˙MOV ˙R0,R3 ˙ ˙;REMEMBER START OF TABLE SCAN2B: ˙MOV ˙(R0)+,R2 ˙;NEXT PROTOTYPE POINTER TO R2 ˙TST ˙@R0 ˙ ˙;SEE IF LIST IS EqTEXT ; R0 = MAX CHAR COUNT ; R3 = CHAR CHECK ROUTINE ; PAUS01: ˙INC ˙R1 ˙ ˙;SKIP PAST O/Z ˙JSR ˙PC,CNXC ˙ ˙;FIRST LETTER MUST NOT BE EOL ˙BEQ ˙PAUSEX ˙ ˙;ERROR IF EOL ˙MOVB ˙@R1,R2 ˙ ˙;SAVE FIRST DIGIT TO BE LOOKED ˙ ˙ ˙ ˙;AT AFTER RETURN FROM 'PAUS01' PAUS02: ˙JSR ˙PC,@R3 ˙ ˙;CHECK AS OCTAL/HEX ˙BVS ˙PAUSEX ˙ ˙;ERROR - BAD CHAR ˙DEC ˙R0 ˙ ˙;COUNT THIS CHAR ˙BEQ ˙PAUSEX ˙ ˙;BR => TOO MANY CHARS ˙MOVB ˙(R1)+,R4 ˙;GET THE CHAR FOR OUTPUT ˙JSR ˙PC,OUTCHR ˙;OUTPUT ONE CHAR ˙JSR ˙Pr; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙DAT028 ; ; ˙COPYRIGHT 1971 BY DIGITAL EQUIPMENT CORPORATION ; ˙WRITTEN BY RONALD F. BRENDER ; ; ˙HANDLING OF DATA STATEMENTS MUST ; ˙FOLLOW ALL OTHER SPECIFIICATION STMTS ; ;STEP 0 ˙- IS THIS REALLY A DATA STATEMENT? ; ˙ASSUME YES IF A ZEROsDB BASE FOR ADB JUST CREATED ; ˙(R3)=ADDR OF SYMB TABLE ENTRY ; ;OUTPUTS AND FUNCTIONS ; ˙IF SYMBOL ENTRY NOT DIMENSIONED, THE ADB IS ; ˙ATTACHED (NORMAL EXIT). ; ˙ELSE THE NEW & OLD ADB'S ARE COMPARED: ; ˙IF EQUAL, NORMAL EXIT ; ˙ELSE ERROR EXIT. ; ˙V=0 ˙NORMAL EXIT ; ˙V=1 ˙ERROR EXIT ; ˙ALL REGISTERS PRESERVED ; QADX: ˙MOV ˙R0,-(SP) ˙MOV ˙R2,-(SP) ˙; ˙MOV ˙R3,-(SP) ˙MOV ˙ADBPWD(R3),R0 ˙BNE ˙QADB01 ˙ ˙;0 => CAN USE THIS ADB ;OKAY - ITS GOOD ˙JSR ˙PC,UADBOK ˙;ATTACH THIS ADB QAtNDED ˙BEQ ˙SCAN5 ˙ ˙;EXIT IF FAILURE IN SEARCH ˙MOV ˙R1,R4 ˙ ˙;SET TEXT POINTER SCAN3: ˙MOVB ˙(R4)+,R5 ˙;GET A CHARACTER ˙CMPB ˙R5,#SPACE ˙;IGNORE ˙BEQ ˙SCAN3 ˙ ˙; SPACES ˙CMPB ˙R5,(R2)+ ˙;DOES IT MATCH PROTOTYPE??? ˙BNE ˙SCAN2B ˙ ˙;NO, TRY FOR NEXT ONE ˙CMP ˙R2,@R0 ˙ ˙;IS PROTOTYPE DONE? ˙BLT ˙SCAN3 ˙ ˙;NO ˙SUB ˙R3,R0 ˙ ˙;YES, GET TABLE INDEX ˙TST ˙-(R0) ˙ ˙;FUDGE THE COUNT ˙MOV ˙R4,R1 ˙ ˙;AND ADVANCE STRING POINTER ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙RTS ˙PC ˙ ˙;RETURN TO CALLER uC,CNXC ˙ ˙;FIND NEXT CHAR ˙BEQ ˙PAUS03 ˙ ˙;EOL => NORMAL EXIT ˙BR ˙PAUS02 ˙ ˙;BACK FOR MORE PAUS03: ˙RTS ˙PC ˙ ˙;EXIT WITH ALL OKAY ; ; HEX CONSTANT CASE ; ; PAUSE1: ˙BR ˙PAUSEX ˙ ˙;MAKE HEX INVALID ; ˙.IFNDF ˙PAUSE1 ; PAUSE1: ˙JSR ˙PC,PAUSE6 ˙;INITIAL TEXT OUT ˙MOV ˙#CHKHEX,R3 ˙;HEX CHECK ROUTINE ˙MOV ˙#5,R0 ˙ ˙;AT MOST FOUR CHAR ˙JSR ˙PC,PAUS01 ˙;OUTPUT THE HEX (NOT THE WHAMMY!) ˙BR ˙PAUSE3 ˙ ˙;ALLS WELL ... ; ˙.ENDC ; ; ; ASCII STRING CASE ; ; PAUSE2: ˙BR ˙PAUSEX ˙ ˙vTH LEVEL COMMA ; ˙IS FOUND. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;THIS IS A FAKE SYMBOL TABLE ENTRY. IT IS SUPPOSED ;TO HAVE LENGTH OF 'VALUE'+2 ('VALUE' IS A GLOBAL SYMBOL). ;IT SHOULD ALSO BE ALLOCATTED IN AN IMPURE AREA. ˙.GLOBL ˙FAKSYM,DATTYP,DATVST,BITM,MISC 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 'NwDB05: ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R0 ˙CLV ˙RTS ˙PC ; QADB01: ˙ADD ˙SYMBAS,R0 ˙;GET REAL ADDRESS ˙CMP ˙(R0)+,(R2)+ ˙;STEP OVER 1ST WORD IN EACH ADB ˙CMP ˙(R0),(R2)+ ˙;COMPARE 2ND WORDS ˙BNE ˙QADB02 ˙ ˙;DIFFERENT => NO GOOD ˙MOV ˙(R0)+,R3 ˙;GET 2ND WORD, CONTAINS # DIM'S ˙ROL ˙R3 ˙ROL ˙R3 ˙ROL ˙R3 ˙BIC ˙#177774,R3 ˙;ISOLATE # DIM'S QADB04: ˙CMP ˙(R0)+,(R2)+ ˙BNE ˙QADB02 ˙DEC ˙R3 ˙BNE ˙QADB04 ˙BR ˙QADB05 ; QADB02: ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R2 ˙MOV ˙(SPxWITH SUCCESS SCAN5: ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙SEV ˙ ˙ ˙;SET OVERFLOW IF NOT FOUND ˙RTS ˙PC ˙ ˙;AND RETURN SADLY ; ; ; ˙MOD40 UNPACK ; ; ˙INPUT: R0=ADR OF MOD40 NUMBER(2 WORDS) ; ˙ ˙R1=ADR OF ASCII STRING(6 BYTES) ; ; ˙OUTPUT: R1 POINTS ONE PAST LAST GENERATED CHAR. ; ; ˙IF N IS THE MOD40 NUMBER, THEN ; ˙ ˙N=C1*40^2+C2*40+C3 ; ˙THUS N/40^2 IS C1 AND THE REMAINDER IS C2*40+C3 ; ˙THE REMAINDER IS DIVIDED BY 40 TO GET y;MAKE STRINGS INVALID ; ˙.IFNDF ˙PAUSE2 ; PAUSE2: ˙INC ˙R1 ˙ ˙;STEP PAST OPENING ' ˙JSR ˙PC,PAUSE6 ˙;INITIAL TEXT PAUS21: ˙MOVB ˙(R1)+,R4 ˙;TST FOR EOL ˙BEQ ˙PAUSEX ˙ ˙;DIDN'T TERMINATE THE STRING ˙CMPB ˙#'',R4 ˙ ˙;LOOK FOR EMBEDDED ' ˙BEQ ˙PAUS23 PAUS22: ˙JSR ˙PC,OUTCHR ˙BR ˙PAUS21 ˙ ˙;GET MORE ; PAUS23: ˙MOVB ˙(R1)+,R4 ˙;HAVE ONE PRIME - ANOTHER? ˙CMPB ˙#'',R4 ˙BEQ ˙PAUS22 ˙ ˙;BR => YES - INCLUDE ONE IN STRING ˙BR ˙PAUSE3 ˙ ˙;OTHERWISE TERMINATE ; ˙.ENDC ; ; ; OUTPUT THEzOCNSV' CONTROLS ˙ ˙ ˙ ˙;CONSTANTS GETTING STORED ˙TSTB ˙BLKDAT ˙ ˙;SKIP TRANSFER IF BLOCK DATA ˙BNE ˙DATA03 ˙MOV ˙FLABL,-(SP) ˙INC ˙FLABL ˙ ˙;INCREASE POINTER FOR NEXT USE ;GENERATE TRANSFER AROUND ANY ALLOCATED STORAGE ˙MOV ˙#DATT04,R4 ˙JSR ˙PC,PUTNAM ˙;"$TR," ˙BITB ˙BITM+4,MISC+0 ˙;IS THE GLOBAL ALREADY DONE?? ˙BNE ˙DATA04 ˙ ˙;YES ˙BISB ˙BITM+4,MISC+0 ˙;SET DONE FLAG ˙JSR ˙PC,OUTGL ˙;OUTPUT THE GLOBAL ˙JSR ˙PC,EOL ˙ ˙;AN END OF LINE DATA04: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAM{)+,R0 ˙SEV ˙RTS ˙PC ; ; ;UADBOK: ˙ATTACHES ADB TO SYMBOL TABLE ENTRY ; ˙(R2)=START OF ADB ; ˙(R3)=SYMBOL TABLE START ; UADBOK: ˙SUB ˙#T5,SP ˙ ˙;RESERVE TEMPS ˙MOV ˙R4,(SP) ˙MOV ˙R5,T2(SP) UADB02: ˙MOV ˙SYMNXT,R4 ˙;ATTACH ADB TO ENTRY ˙MOV ˙R4,ADBPWD(R3) ;PUT ADB POINTER INTO ENTRY ˙SUB ˙SYMBAS,ADBPWD(R3) ;MAKE REL. TO STRT OF TBL ˙TST ˙ADBCUR ˙;IS THIS THE 1ST ADB? ˙BEQ ˙UADB04 ˙;BR IF YES, ELSE-- ˙MOV ˙ADBPWD(R3)|C2, ETC. ; ; ˙REGISTERS CHANGED - R1 ; ˙.GLOBL ˙UNPK00 UNPK00: ˙MOV ˙R0,-(SP) ˙MOV ˙R2,-(SP) ˙MOV ˙R3,-(SP) ˙MOV ˙R4,-(SP) ˙MOV ˙R5,-(SP) ˙MOV ˙#-2,R4 ˙ ˙;MAJOR LOOP COUNT UNPK07: ˙MOV ˙#-3,R5 ˙ ˙;MINOR LOOP COUNT ˙MOV ˙(R0),R0 ˙ ˙;GET MOD40 WORD ˙MOV ˙#COEFF,R2 ˙;PTR TO COEFFICIENTS UNPK06: ˙CLR ˙R3 ˙ ˙;0 QUOTIENT ; ˙DIVIDE BY QUOTIENTS UNPK02: ˙CMP ˙R0,(R2) ˙ ˙;DONE WITH DIVIDE? ˙BLO ˙UNPK01 ˙ ˙;YES ˙SUB ˙(R2),R0 ˙ ˙;NO, SUBTRACT COEFF. ˙INC ˙R3 ˙ ˙;ADD ONE TO QUOTIENT ˙B} INITIAL TEXT ; PAUSE6: ˙JSR ˙PC,GENLAB ˙;GENERATE LABEL IF ANY HERE ˙JSR ˙PC,OUTLN1 ˙;"$PAUSE" OR "$STOP" ˙JSR ˙R5,OUTLN2 ˙PAUST0 ˙RTS ˙PC ; ; PIECES OF THE TEXT ; PAUTXT: ˙.ASCII ˙/ ˙.GLOBL ˙$PAUSE/ ˙.BYTE ˙CR,LF ˙.BYTE ˙TAB ˙.ASCII ˙"$PAUSE" ˙.BYTE ˙0 ; STOTXT: ˙.ASCII ˙/ ˙.GLOBL ˙$STOP/ ˙.BYTE ˙CR,LF ˙.BYTE ˙TAB ˙.ASCII ˙"$STOP" ˙.BYTE ˙0 ; PAUST0: ˙.BYTE ˙CR,LF,TAB ˙.ASCII ˙".ASCII" ˙.BYTE ˙TAB,A~E ˙JSR ˙PC,OUTCOM ˙;AND A COMMA ˙.GLOBL ˙PUTNAM,OUTGL,OUTNAM,OUTCOM ˙MOV ˙@SP,R3 ˙MOV ˙#'F,R0 ˙JSR ˙PC,OUTSER ˙JSR ˙PC,EOL DATA03: ˙MOV ˙R1,R0 ˙ ˙;REMEMBER CURRENT TEXT DATA02: ˙MOVB ˙(R1)+,R2 ˙;FIND FIRST / ˙BEQ ˙DATA90 ˙ ˙;BR=>NO / ˙CMPB ˙#'/,R2 ˙BNE ˙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 ,@ADBCUR ˙;PUT POINTER INTO LAST ˙ ˙;ADB ENTERED. UADB04: ˙MOV ˙R4,ADBCUR ˙;UPDATE CURRENT ADB POINTER ˙MOV ˙2(R2),R5 ˙;DETERMINE SIZE OF ADB ˙ROL ˙R5 ˙ROL ˙R5 ˙ROL ˙R5 ˙BIC ˙#177774,R5 ˙;# OF DIMENSIONS ˙MOV ˙R5,T4(SP) ˙;SAVE # DIM'S ˙ADD ˙#2,R5 ˙;ADD CONSTANT AMOUNT FOR ADB HDR ˙ASL ˙R5 ˙;TIMES 2 FOR NO. OF WORDS ˙ADD ˙R5,SYMNXT ˙;UPDATE POINTER TO FREE ˙ ˙;SYMBOL TABLE SPACE ˙CMP ˙SYMNXT,SYMEND ˙;WILL ADB FIT IN TABLE? ˙BHI ˙UADB05 ˙;BR IF NOT ˙MOV ˙R3,T3(SP) ˙;SAVE R3,S€R ˙UNPK02 ; ˙DIVIDE DONE. QUOT. IN R3, REMAINDER IN R0 ; ˙CONVERT TO AN ASCII CHARACTER UNPK01: ˙TSTB ˙R3 ˙BEQ ˙UNPK03 ˙;"BLANK" ˙CMPB ˙R3,#33 ˙BEQ ˙UNPK05 ˙ ˙;"$" ˙BGT ˙UNPK04 ˙ ˙;"." OR "0-9" ˙ADD ˙#40,R3 ˙ ˙;"A-Z" UNPK03: ˙ADD ˙#16,R3 UNPK04: ˙ADD ˙#11,R3 UNPK05: ˙ADD ˙#11,R3 ˙MOVB ˙R3,(R1)+ ˙;STORE CHARACTER ˙TST ˙(R2)+ ˙ ˙;ADVANCE COEFF. ˙INC ˙R5 ˙ ˙;3 CHARS DONE?? ˙BLT ˙UNPK06 ˙ ˙;NO, DO MORE ˙MOV ˙10(SP),R0 ˙;RESTORE R0 AND ˙TST ˙(R0)+ ˙ ˙;MOVE TO NEXT WORD ˙INC ˙R4 ˙ SCDLM,0 ; PAUST5: ˙.BYTE ˙ASCDLM PAUST1: ˙.BYTE ˙CR,LF,TAB ˙.ASCII ˙".BYTE 0" ˙.BYTE ˙CR,LF,TAB ˙.ASCII ˙".EVEN" ˙.BYTE ˙CR,LF,0 ; ˙.EVEN ASCDLM ˙='^ ˙ ˙ ˙;USE ^ FOR ASCII DELIMITER CR ˙=015 ˙ ˙ ˙;CARRIER RETURN LF ˙=012 ˙ ˙ ˙;LINE-FEED TAB ˙=011 ˙ ˙ ˙;HORIZONTAL TAB ˙.END ‚ ˙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: ˙MOV ˙#DATT01,R4 ˙;RETURN TO PROGRAM CSECT ˙JSR ˙PC,OUTLN1 ˙;".CSECT" ˙TSTB ˙BLKDAT ˙BNE ˙DATA93 ˙MOV ˙(SP)+,R3 ˙;LABEL FOR THE ABOVE TRANSFER ˙MOV ˙#'F,R0 ˙JSR ˙PC,OUTSER ˙MOV ˙#DATT05,R4 ˙JSR ˙PC,OUTLN1 ˙;":" DATA93: ˙CLRB ˙GETSW ˙ ˙;RETURN TO PRE-DATA VALUE ˙CLV ˙RTS ˙PC ; ; DATTƒET R3=SOURCE OF MOVE ˙MOV ˙R2,R3 ˙;R4 ALREADY INITIALIZED ˙JSR ˙PC,MOVE ˙MOV ˙T3(SP),R3 ˙;RESTORE R3 ;PUT DIM INTO ENTRY. ˙MOV ˙T4(SP),R5 ˙;RECALL # DIM'S ˙SWAB ˙R5 ˙ASL ˙R5 ˙BIC ˙#DIMMK,R5 ;ISOLATES FIELD TO BE INSERTED ˙BIC ˙#DIMMKM,DIMWD(R3) ;ZEROS OUT RESULT FIELD ˙BIS ˙R5,DIMWD(R3) ;ADB NOW PROPERLY ATTACHED TO SYMBOL TABLE ENTRY. ;DO A NORMAL RETURN. UADB03: ˙MOV ˙T2(SP),R5 ˙;RESTORE R5,R4 ˙MOV ˙(SP),R4 ˙ADD ˙#T5,SP ˙;RELEASE TEMPS ˙CLV ˙ ˙;V=0 ˙RTS ˙PC UADB05: ˙TRAP+5„˙;DONE TWO WORDS? ˙BLT ˙UNPK07 ˙ ˙;NO ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R0 ˙RTS ˙PC ˙ ˙;YES, QUIT ; ; ˙COEFFICIENT TABLE ; COEFF: ˙1600. ˙ ˙ ˙;40^2 ˙40. ˙ ˙ ˙;40^1 ˙1. ˙ ˙ ˙;40^0 ˙.GLOBL CHKOCT,CHKHEX,ZLEQLS ˙.GLOBL ˙OUTOCT,OUTST,OUTSTR ; ; ; ; ; OUTOCT ; ; OUTPUT THE NUMBER IN R3 TO THE OBJECT DEVICE ; ALWAYS GENERATES 6 CHARS ; AS ASCII OCTAL EQUIVALENT ; REGISTERS CHANGED - R3 ; OUTOCT: ˙MOV ˙R2,-(SP) ˙;SAVE R2 ˙MOV†01: ˙.BYTE ˙TAB ˙ ˙;" .CSECT " ˙.ASCII ˙'.CSECT' ˙.BYTE ˙CR,LF,0 DATT04: ˙.BYTE ˙TAB ˙.ASCII ˙"$TR" ˙.BYTE ˙0 DATT05: ˙.BYTE ˙':,CR,LF,0 ˙.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, . ˙;"SYMBOL TABLE FULL" ˙MOV ˙LOW,SP ˙;ABORT ˙JMP ˙SCANNR ˙;THE STATEMENT ˙.GLOBL ˙LOW,SCANNR ; ; .END ; ; ˆ ˙R4,-(SP) ˙MOV ˙R5,-(SP) ˙ADD ˙#-6,SP ˙ ˙;CLAIM 6 BYTES OF STACK ˙MOV ˙SP,R2 ˙ ˙;OUTPUT ADDRESS FOR 'OTOA' ROUTINE ˙JSR ˙PC,OTOA ˙ ˙;CONVERT TO TEXT ˙MOV ˙SP,R4 ˙ ˙;ADDRESS FOR OUTPUT ROUTINES ˙MOV ˙#6,R5 ˙ ˙;COUNT FOR 'OUTLN' ˙JSR ˙PC,OUTLN ˙;BYE, BYE? ˙ADD ˙#6,SP ˙ ˙;PICK-UP AFTER THE PARTY ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙MOV ˙(SP)+,R2 ˙RTS ˙PC ; ; OUTST ; ; OUTPUT THE ASCII NAME OF A VARIABLE TO THE ; OBJECT DEVICE GIVEN THE ADDRESS IN THE ; SYMBOL TABLE IN R0 ON ‰; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙ASC1 ˙;ASSIGNMENT AND CALL ˙.GLOBL ˙FUNC13,ARY004,GL1,EXEC,PARMKM,PARWD ˙.GLOBL ˙GENLAB,GET,NXTCH,FUN000,EXPGEN,CURSYM ˙.GLOBL ˙IOL,SUBEXP,CHR,PUTCHR,BITM,CV1,OUTGL ˙.GLOBL ˙EOL,OUTNAM,ARYASG,SERATR,STKCNT ˙.GLOBL ˙ASGN8,ASGN9,CALL03,CALL0ŠPREVIOUSLY 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 ‹; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙COM024 ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ;WRITTEN BY RON BRENDER ;MODULE FOR COMMON AND EQUIVALENCE DECLARATIONS ;HANDING OCCURS IN TWO PHASES: ; ˙1) AT THE TIME A STATEMENT IS ENCOUNTERED, ROUTINES ; ˙ PARSE TŒENTRY. ; REGISTERS CHANGED - NONE ; OUTSTR: ˙ADD ˙SYMBAS,R0 OUTST: ˙MOV ˙R4,-(SP) ˙;YES ˙MOV ˙R5,-(SP) ˙;LIKEWISE ˙MOV ˙R1,-(SP) ˙MOV ˙R0,-(SP) ˙MOV ˙SP,R4 ˙ ˙;REMEMBER END OF SYMBOL ˙ADD ˙#SYM1WD,R0 ˙;GET ADDRESS OF PACKED SYMBOL ˙SUB ˙#6,SP ˙ ˙;NEED 6 BYTES FOR THE UNPACKER ˙MOV ˙SP,R1 ˙ ˙;TELL WHERE TO UNPACK ˙JSR ˙PC,UNPK00 ˙;UNPACK IT ; MUST SCRAP TRAILING BLANKS ˙MOV ˙#7,R5 ˙ ˙;START AT 6 CHARS OUTST1: ˙DEC ˙R5 ˙;AND COUNT DOWN ˙CMPB ˙#' ,-(R4) ˙;A BLANK ˙BEQ ˙OUTST1 5 ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; SPACE ˙= ˙40 TAB ˙= ˙11 MODE ˙= ˙60 OP ˙= ˙20 ; ; FORTRAN EXPRESSION PROCESSING PACKAGE ; ; CALL STATEMENT ; ˙.GLOBL ˙CALL CALL: ˙MOV ˙#1,EXEC ˙ ˙;MUST BE EXECUTABLE ˙JSR ˙PC,GENLAB ˙;GENERATE A LABEL ˙JSR ˙PC,GET ˙ ˙;GET THE REFERENCE TO THE NAME ˙BVS ˙CALL01 ˙TST ˙R3 ˙ ˙;IS IT A CONSTANT? ˙BMI ˙CALL01 ˙ ˙;YES, ERROR!!!!! ˙MOV ˙R2,-(SP) ˙;SAVE THE TYPE ˙CMP ˙R3,#2 ˙ ˙;IS IT A FŽ; ;INPUT: ˙R0 - BEGINNING OF VARIABLE NAME TEXT ; ˙R1 - BEGINNING 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)HE TEXT AND BUILD A DATA STRUCTURE ; ˙ CONTAINING ITS INFORMATION ; ˙2) AT THE END OF THE NON-EXECUTABLE STATEMENTS, A ; ˙ ROUTINE '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,ALOC ˙.GLOBL ˙DATYWD,DATYMK,ADBPWD,ADJWD,ADJMKM ˙.GLOBL ˙SYMBAS,OUTCSX,SIZXSM,SIZXSN,SIZXSQ,SIZXT ˙.GLOBL ˙ZLEQLS,QADBOK,COMWD,COMMKM,COMNWD ˙.GL˙ ˙;MUST TERMINATE FOR LEGAL SYMBOLS ˙MOV ˙SP,R4 ˙ ˙;BASE OF SYMBOL ˙JSR ˙PC,OUTLN ˙;OUTPUT ˙ADD ˙#6,SP ˙;CLEAN HOUSE ˙MOV ˙(SP)+,R0 ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙RTS ˙PC ; ; OUTSER ; ; ˙OUTPUT THE SERIAL NUMBER IN R3 PREFIXED BY ; ˙$X, WHERE X IS THE ASCII CHARACTER IN R0 ; ˙.GLOBL ˙OUTSER OUTSER: ˙MOV ˙R2,-(SP) ˙;SAVE R2 ˙MOV ˙R4,-(SP) ˙;AND R4 ˙MOV ˙R5,-(SP) ˙;AND R5 ˙SUB ˙#6,SP ˙ ˙;MAKE ROOM ON THE STACK ˙MOV ˙SP,R2 ˙ ˙;GET ADDRESS FOR CONVERSION ˙JSR‘UNCTION REFERENCE? ˙BNE ˙CALL04 ˙ ˙;NO ˙JSR ˙PC,NXTCH ˙;GET NEXT CHARACTER ˙DEC ˙R1 ˙CMPB ˙R2,#'( ˙ ˙;IS IT A LEFT PAREN? ˙BEQ ˙CALL08 ˙ ˙;YES ˙BR ˙CALL06 CALL08: ˙MOV ˙(SP)+,R2 ˙;RESTORE TYPE ˙MOV ˙SP,R5 ˙ ˙;REMEMBER STARTING POINT ˙˙JSR ˙PC,FUN000 ˙;PRETEND IT IS A FUNCTION ˙TST ˙-(R5) ˙ ˙;DECREMENT POINTER ˙MOV ˙R5,R0 ˙ ˙;SET STARTING POINT ˙CLR ˙-(SP) ˙ ˙;SET TERMINATOR ˙MOV ˙R5,-(SP) ˙;REMEMBER START ˙JSR ˙PC,EXPGEN ˙;GENERATE CODE FOR IT CALL03: ˙MOV ˙(SP)+,R0 ˙;NOW ˙MO’ ˙MOV ˙CURSYM,R3 ˙MOV ˙DATYWD(R3),DATTYP ˙;REMEMBER TYPE WORD ;DO CONSTANT PART ˙MOV ˙CON(SP),R1 ˙JSR ˙PC,DATCON ˙BCS ˙DATA19 ˙ ˙;BR=>BAIL OUT ˙JSR ˙PC,CNXC ˙MOV ˙R1,CON(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 ; DATA“OBL ˙CNXC,GETID,LSTITM,EQVDEL ˙.GLOBL ˙NXTCH,COMMON,EOL,EQVH3,EQVDEL ˙.GLOBL ˙OUTST,OUTOCT,TYPSIZ,BLKNAM ˙.GLOBL ˙COMNXT,COMHGH,COMNUM,OUTSTR ;COMMON 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 - LINK TO NEXT SU” ˙PC,OTOA ˙ ˙;CONVERT TO ASCII ˙MOVB ˙#'$,-6(R2) ˙;ADD THE $X ˙MOVB ˙R0,-5(R2) ˙; PREFIX ˙MOV ˙SP,R4 ˙ ˙;OUTPUT ˙MOV ˙#6,R5 ˙ ˙; THE ˙JSR ˙PC,OUTLN ˙; CHARACTERS ˙ADD ˙#6,SP ˙ ˙;RESTORE THE STACK ˙MOV ˙(SP)+,R5 ˙;RESTORE ˙MOV ˙(SP)+,R4 ˙; THE ˙MOV ˙(SP)+,R2 ˙; REGISTERS ˙RTS ˙PC ; VARIOUS CHECK ROUTINES ; ; ˙INPUT: R1 POINTS TO CHAR TO BE CHECKED ; ˙OUTPUT: V=0 => CHAR IS OK FOR THAT TYPE ; ˙ ˙V=1 => CHAR NOT OF TH•V ˙R0,SP ˙ ˙;DISCARD CALL07: ˙TST ˙(SP)+ ˙ ˙;THE POLISH CALL7B: ˙CMPB ˙@R1,#' ˙ ˙;IS IT A SPACE? ˙BNE ˙CALL7A ˙ ˙;NO ˙INC ˙R1 ˙BR ˙CALL7B CALL7A: ˙TSTB ˙@R1 ˙ ˙;END OF LINE?? ˙BEQ ˙CALL02 ˙ ˙;YES ˙TRAP+35 ˙ ˙ ˙;NO, ILLEGAL TERMINATION CALL02: ˙RTS ˙PC CALL1A: ˙TST ˙(SP)+ CALL01: ˙TRAP+46 ˙ ˙ ˙;ILLEGAL ROUTINE NAME ˙RTS ˙PC CALL04: ˙MOV ˙CURSYM,R0 ˙.GLOBL ˙SGLMKM,SGLWD,ENTYWD ˙BIT ˙#SGLMKM,SGLWD(R0) ˙;IS THIS THE ONLY OCCURENCE? ˙BEQ ˙CALL1A ˙ ˙;NO ;EXTERNAL DOESN'T WORK, SO MAKE–11: ˙CLR ˙R0 ˙TST ˙DATVCT ˙ ˙;WILL REPEAT VARIABLE ˙BNE ˙DATA14 ˙ ˙;BR => YES ˙CMPB ˙#',,@TXT(SP) ˙;MORE VARIABLE ˙BNE ˙DATA13 ˙ ˙;BR => 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) —BBLOCK ; ˙ ˙WORD 1+N - LINK TO STE OF N'TH VARIABLE ; ˙ ˙WORD 2+N - ZERO ENDS SUBBLOCK R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 COMMON: ˙TSTB ˙ALOKAT ˙BNE ˙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˜AT TYPE ; ˙ ˙R5 = BINARY VALUE OF CONVERTED CHAR ; ; CHKOCT - CHECK FOR OCTAL DIGIT (0-7) ; CHKHEX - CHECK FOR HEX DIGIT (0-F) ; CHKOCT: ˙CMPB ˙@R1,#'0 ˙ ˙;LOOK FOR OCTAL DIGIT ˙BLT ˙CHKOC1 ˙ ˙;SET V IF NOT FOUND ˙CMPB ˙@R1,#'7 ˙;MAKE SURE IT IS NOT TOO BIG ˙BGT ˙CHKOC1 CHKOC2: ˙MOVB ˙@R1,R5 ˙;RETURN VALUE IN R5 ˙SUB ˙#'0,R5 ˙CLV ˙RTS ˙PC CHKOC1: ˙SEV ˙RTS ˙PC ; ; CHECK FOR HEX ; CHKHEX: ˙CMPB ˙@R1,#'0 ˙BLT ˙CHKHE1 ˙CMPB ˙@R1,#'9 ˙BLE ˙CHKOC2 ˙ ˙;OK IF A DIGIT ˙CMPB ˙@R1,™ THE FOLLOWING TWO ;LINES FORCE AN ERROR ON AN EXTERNAL USAGE FOR NOW ˙BIT ˙#PARMKM,PARWD(R0) ˙;IS IT A PARAMETER ˙BNE ˙CALL1A ˙ ˙;YES, IT DOESN'T WORK ˙BIS ˙#100000,ENTYWD(R0) ˙;SET FUNCTION MODE CALL06: ˙CLR ˙-(SP) ˙ ˙;SET ZERO PARAMETERS ˙MOV ˙#-1,IOL ˙ ˙;SET RETURN FLAG ˙JMP ˙FUNC13 ˙ ˙;GO GENERATE CALL CALL05: ˙CLR ˙IOL ˙ ˙;RESET ˙BR ˙CALL07 ˙ ˙;AND RETURN ; ; ASSIGNMENT STATEMENT ; ; ˙THIS IS THE LAST CHANCE FOR A FORTRAN STATEMENT ; ˙TO MAKE GOOD WITH THE WORLD. ; ; ˙IT IS ASSš ˙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 THIS 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) ˙;A› ˙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)+,(R2)+ ˙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 ˙ œ#'A ˙BLT ˙CHKHE1 ˙CMPB ˙@R1,#'F ˙BLE ˙CHKHE2 ˙ ˙;OK IF LETTER A-F CHKHE1: ˙SEV ˙RTS ˙PC CHKHE2: ˙MOVB ˙@R1,R5 ˙SUB ˙#'A-10.,R5 ˙;HEX VALUE ˙CLV ˙RTS ˙PC ; ; ; 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 ˙BEUMED TO BE AN ASSIGNMENT AT THIS POINT ; ˙IF IT HAS AN EQUAL SIGN IN IT. ; ˙.GLOBL ˙ASGN4A ˙.GLOBL ˙OUTCHR,EOL,PUTNM1,ASGNN ASGNN: ˙MOV ˙R1,-(SP) ˙;SAVE START ADDRESS ASGN1: ˙MOVB ˙(R1)+,R2 ˙;GET A CHARACTER ˙BEQ ˙ASGER1 ˙ ˙;QUIT AT END-OF-LINE ˙CMPB ˙R2,#'= ˙ ˙;IS IT AN EQUAL?? ˙BNE ˙ASGN1 ˙ ˙;NO ˙MOV ˙#1,EXEC ˙ ˙;THIS MUST BE EXECUTABLE ˙JSR ˙PC,GENLAB ˙;GENERATE A LABEL, IF ANY ˙JSR ˙PC,SUBEXP ˙;CONVERT TO POLISH ˙MOV ˙R0,-(SP) ˙;SAVE THE POINTER ˙MOV ˙R2,-(SP) ˙;SAVE THE MODE žLSO 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 DATVAR: ˙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Ÿ˙;BR => NAME OKAY ˙TRAP+42. ˙;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 ˙COM11 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  Q ˙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,R4 ˙BR ˙LABEY ; ; ZLEQLS ; ; CHECK FOR ZEROTH LEVEL = SIGN IN INPUT LINE. ; ˙NOTE THAT A ZERO LEVEL COMMA IS ASSUMED TO ; ˙IMPLY THAT NO ZERO LEVEL = WILL BE FOĄ ˙JSR ˙PC,EXPGEN ˙;GENERATE SOME CODE ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R0 ˙;NOW ˙MOV ˙R0,SP ˙ ˙;THROW AWAY THE POLISH ˙TST ˙(SP)+ ASGN18: ˙CMPB ˙@R1,#' ˙ ˙;SKIP ˙BNE ˙ASGN17 ˙ ˙;ALL ˙INC ˙R1 ˙ ˙;BLANKS ˙BR ˙ASGN18 ˙ ˙;HERE ASGN17: ˙TSTB ˙@R1 ˙ ˙;IS THE TERMINATOR ZERO??? ˙BEQ ˙ASGN2 ˙ ˙;YES ˙CMPB ˙@R1,#') ˙ ˙;CLOSING PAREN?? ˙BNE ˙ASGN12 ˙ ˙;NO ˙TRAP+25. ˙ ˙;MIS-MATCHED PARENS ˙BR ˙ASGN2 ASGER1: ˙BR ˙ASGERR ASGN12: ˙TRAP+29. ASGN2: ˙MOV ˙(SP)+,R1 ˙;REMEMBER OLD STARTING POINT ˙MO˘ ˙#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 ADJUSTABLE ˙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. Ł˙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 ;ADD A NEW BLOCK NAME COM10: ˙MOV ˙COMNXT,R0 ˙MOV ˙R0,@R2 ˙ ˙;LINK FROM PREVIOUS BLOCK ˙ADD ˙#14,COMNXT ˙;UPDATE FREE SPACE POINTER ˙CMP ˙COMNXT,COMHGH ˙BHI ˙COM91 ˙CLR ˙(R0)+ ˙ ˙;CLEAR LINK TO NEXT BLOCK ˙MOV ˙#BLKNAM,R3 ˙MOV ˙(R3)+,(R0)+ ˙;MOVE NAM¤UND. ; ; ˙INPUT: R1 - POINTS AT TEXT STRING ; ˙OUTPUT: C=0 =>NONE FOUND ; ˙ ˙C=1 =>ZEROTH LEVEL FOUND ; ; ˙REGISTERS CHANGED - NONE. ; ZLEQLS: ˙MOV ˙R1,-(SP) ˙CLR ˙-(SP) ˙ ˙;WILL COUNT DEPTH HERE ZLEQL1: ˙TSTB ˙@R1 ˙ ˙;GET THE CHAR ˙BEQ ˙˙ZLEQLX ˙ ˙;JUMP IF END OF LINE ˙CMPB ˙#',,@R1 ˙BEQ ˙ZLEQLC ˙CMPB ˙#'=,@R1 ˙BEQ ˙ZLEQLE ˙ ˙;HAVE = ˙CMPB ˙#'(,@R1 ˙BEQ ˙ZLEQLL ˙ ˙;NAVE ( ˙CMPB ˙#'),@R1 ˙BEQ ˙ZLEQLR ˙ ˙;HAVE ) ZLEQ1: ˙INC ˙R1 ˙ ˙;ADVANCE POINTER ˙BR ˙ZLEQL1 ˙ ˙;TO NEXT CHAĽV ˙R2,-(SP) ˙JSR ˙PC,GET ˙ ˙;GET THE SERIAL OF THE ASSIGNMENT ˙TST ˙R3 ˙ ˙;CHECK LEGALITY ˙BMI ˙ASGBD1 ˙ ˙;CAN'T ASSIGN TO A CONSTANT ˙DEC ˙R3 ˙ ˙;CHECK FOR ARRAY ˙BGT ˙ASGBD2 ˙ ˙;CAN'T ASSIGN TO FUNCTION ˙MOV ˙(SP)+,R3 ˙;SIMPLE VARIABLE OR ARRAY ˙SWAB ˙R3 ˙ASR ˙R3 ˙ASR ˙R3 ˙ASR ˙R3 ˙ASR ˙R3 ˙CMPB ˙CHR(R2),CHR(R3) ˙;SAME MODE?? ˙BEQ ˙ASGN4 ˙ ˙;YES ˙MOVB ˙#TAB,R4 ˙JSR ˙PC,PUTCHR ˙MOVB ˙#'$,R4 ˙ ˙;MODE ˙JSR ˙PC,PUTCHR ˙;CONVERSION ˙MOVB ˙CHR(R3),R4 ˙;IF ˙JSR ˙PC,PUTCHR Ś ˙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 ˙DATV11 ˙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 §E INTO BLOCK BODY ˙MOV ˙(R3)+,(R0)+ ˙MOV ˙(R3)+,(R0)+ ˙CLR ˙(R0)+ ;R0 CONTAINS ADDRESS OF LINK POINT COM101: ˙MOV ˙COMNXT,@R0 ˙;LINK TO NEW AREA ˙MOV ˙@R0,R0 ˙CLR ˙(R0)+ ˙ ˙;CLEAR LINK AT BEGIN OF SUBBLOC ˙MOV ˙R4,COMNUM ˙;SAVE BLOCK NUMBER ;COLLECTING IDENTIFIER COM20: ˙MOV ˙R0,-(SP) ˙;SAVE R0 ˙MOV ˙#LOCADB,R2 ˙;PUT ADB HERE FOR NOW ˙JSR ˙PC,LSTITM ˙;HANDLE LIST ITEM ˙BNE ˙COM94 ˙ ˙;IF AN ERROR - SKIP FORWARD ˙BIT ˙AD¨R ; ZLEQLL: ˙INC ˙@SP ˙ ˙;UP THE PAREN COUNT ˙BR ˙ZLEQ1 ZLEQLR: ˙DEC ˙@SP ˙ ˙;DOWN THE PAREN COUNT ˙BR ˙ZLEQ1 ZLEQLE: ˙TST ˙@SP ˙ ˙;WE ARE DONE IF IT IS ZERO ˙BNE ˙ZLEQ1 ˙ ˙;KEEP SCANNING ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R1 ˙SEC ˙ ˙;DECLARE IT FOUND ˙RTS ˙PC ; ZLEQLC: ˙TST ˙@SP ˙BNE ˙ZLEQ1 ZLEQLX: ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R1 ˙CLC ˙RTS ˙PC ˙.END ; ; GENERATE STATEMENT LABEL FOR EXECUTABLE STATEMENT ; GENLAB: ˙TST ˙INHŠ˙;NOT ˙MOVB ˙CHR(R2),R4 ˙;THE ˙JSR ˙PC,PUTCHR ˙;SAME ˙BITB ˙BITM(R3),CV1(R2) ;GENERATE GLOBAL? ˙BNE ˙ASG10 ˙ ˙;NO ˙BISB ˙BITM(R3),CV1(R2) ;YES, SET GENERATED FLAG ˙JSR ˙PC,OUTGL ˙;NOW OUTPUT IT ˙JSR ˙PC,EOL ASG10: ˙JSR ˙PC,OUTNAM ˙JSR ˙PC,EOL ˙ ˙;MODE ASGN4: ˙JSR ˙PC,SERATR ˙;GET THE MODE AGAIN ˙CMP ˙R3,#1 ˙ ˙;IS IT ARRAY????????? ˙BEQ ˙ASGN3 ˙ ˙;YEP, GO TO IT ASGN4A: ˙JSR ˙PC,ASGCOM ˙;CALL POP GOODIES ˙.GLOBL ˙ASGCOM ASGN16: ˙JSR ˙PC,NXTCH ˙;GET THE NEXT CHARACTER ˙CMPB ˙R2,#'Ş ˙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 ; ;HERE ALLOCATE THE DATA ITEM ; ˙BIS ˙#ALLMKM,ALLOWD(R3) ;SET ALLOCATED BIT ˙MOV ˙R3,-(SP) ˙;SAVE AWAY ŤJWD(R3),#ADJMKM ˙BNE ˙COM92 ˙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 ˙COM94 ˙ ˙;BR=>SOME ERROR ;AT THIS POINT ALL IS WELL - USE THIS LIST ITEM COM30: ˙MOV ˙(SP)+,R0 ˙SUB ˙SYMBAS,R3 ˙MOV ˙R3,(R0)+ ˙;PUT ST DISPLACEMENT IN COMMON BLOCK ˙CLR ˙(ŹLAB ˙ ˙;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 ˙­= ˙ ˙;IT MUST BE AN EQUAL ˙BEQ ˙ASGN7 ˙ ˙;IT IS ˙CMPB ˙R2,#'( ˙ ˙;OPEN PAREN? ˙BNE ˙ASGN6 ˙ ˙;NO ˙TRAP+30. ˙ ˙;YES, NO SUBSCRIPT ALLOWED ˙BR ˙ASGN7 ASGERR: ˙TRAP+21. ˙ ˙;UNRECOGNIZED STATEMENT ERROR: ˙MOV ˙(SP)+,R1 ˙;RESTORE REGISTER ERROR1: ˙SEV ˙RTS ˙PC ASGBD1: ˙TRAP+27. ˙TST ˙(SP)+ ˙BR ˙ERROR1 ASGBD2: ˙TRAP+28. ˙TST ˙(SP)+ ˙BR ˙ERROR1 ASGN6: ˙TRAP+31. ˙ ˙;VARIABLE NAME ASSUMED TOO LONG ASGN7: ˙RTS ˙PC ˙ ˙;AND RETURN ; ARRAY ASSIGNMENTS HANDLED HERE ASGN3: ˙INC ˙ARYASG ˙ ˙;IŽ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: ˙MOV ˙#'F,R0 ˙MOV ˙FLABL,R3 ˙JSR ˙PC,OUTSER ˙MOV ˙#DATV23,R4 ˙JSR ˙PC,OUTLN1 ˙;"=..=" ˙MOV ˙CURSYM,R0 ˙JSR ˙PC,DATV30 ˙JSR ˙PC,EOL ˙MOV ˙FLABL,DATLAB ˙INC ˙FLABL ˙BR ˙DATV40 ŻR0)+ ˙ ˙;KEEP ZERO TERMINATOR IN PLACE ˙MOV ˙R0,COMNXT ˙;KEEP FREE SPACE POINTER UP TO DATA ˙CMP ˙COMNXT,COMHGH ˙BHI ˙COM91 ˙ ˙;BR=>TABLE OVERFLOW ˙TST ˙-(R0) ˙ ˙;REALLY WANT R0 POINTING HERE. ;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 ˙COMM02 COM90: ˙TRAP+42. ˙ ˙;"ILLEGAL SYNTAX" ˙TSTB ˙@R°.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,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, SąNCREMENT ARRAY ASSIGNMENT ˙MOV ˙SP,STKCNT ˙JMP ˙ARY004 ˙ ˙;GO HANDLE SUBSCRIPTS ASGN8: ˙CLR ˙ARYASG ˙TRAP+26. ˙BR ˙ASGN4A ASGN9: ˙MOV ˙STKCNT,R0 ˙;GET ADDRESS OF STRING ˙CLR ˙-(SP) ˙ ˙;ADD TERMINATOR ˙TST ˙-(R0) ˙ ˙;POINT TO STRING DIRECTLY ˙MOV ˙R2,-(SP) ˙;REMEMBER MODE ˙JSR ˙PC,EXPGEN ˙;GENERATE SOME CODE ˙MOV ˙(SP)+,R2 ˙;GET TYPE BACK ˙CLR ˙ARYASG ˙;TURN OFF ARRAY ASSIGNMENT ˙MOV ˙STKCNT,SP ˙MOV ˙#ASGN10,R4 ˙;OUTPUT ˙JSR ˙PC,PUTNM1 ˙;$PUT ˙SWAB ˙R2 ˙ ˙;GET ˙ASR ˙R2 ˙ ˙;T˛ ; ; ; DATV23: ˙.BYTE ˙TAB,'=,'.,CR,LF,'.,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 ˙ł1 ˙BEQ ˙COMEND ˙INC ˙R1 ˙BR ˙COM20 ˙ ˙;TRY TO CONTINUE ; ; END OF COMMON STATEMENT ; PICK UP THE MARBLES AND GO HOME ; COMEND: ˙TST ˙(R0)+ COME02: ˙MOV ˙R0,COMNXT ˙CMP ˙COMNXT,COMHGH ˙BHI ˙COM91 COME01: ˙CLV ˙RTS ˙PC COM91: ˙˙TRAP+43. ˙ ˙ ˙;"TABLE OVERFLOW" ˙BR ˙COME01 COM92: ˙MOV ˙(SP)+,R0 ˙TRAP+44. ˙ ˙ ˙;"PARAMETER USED IN COMMON/EQUIVALENCE" ˙BR ˙COM31 COM93: ˙MOV ˙(SP)+,R0 ˙TRAP+45. ˙ ˙ ˙;"VARIABLE ALREADY IN COMMON" ˙BR ˙COM31 COM94: ˙MOV ˙(SP)+,R0 ˙BR ˙COM90 ´KIP 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 STATEMENT ; GENLAB: ˙TST ˙INHLAB ˙ ˙;IS THE LABEL NEEDED OR DESIRED? ˙BNE ˙LABEZ ˙ ˙;NOT AT ALL ˙MOV ˙R3,-ľHE ˙ASR ˙R2 ˙ ˙;DATA ˙ASR ˙R2 ˙ ˙;TYPE ˙ASR ˙R2 ˙ ˙;HERE ˙BIC ˙#177770,R2 ˙;AND ˙MOV ˙R2,R4 ˙ADD ˙#60,R4 ˙ ˙;CONVERT ˙JSR ˙PC,PUTCHR ˙;ASCII OUTPUT ˙BITB ˙BITM(R2),GL1+2 ˙;DO WE NEED A PUT OR GET GLOBAL ˙BNE ˙ASG12 ˙ ˙;NO ˙BISB ˙BITM(R2),GL1+2 ˙;SET GENERATED ˙JSR ˙PC,OUTGL ˙JSR ˙PC,EOL ASG12: ˙JSR ˙PC,OUTNAM ˙JSR ˙PC,EOL ˙BR ˙ASGN16 ASGN10: ˙.ASCII ˙/ ˙$PUT/ ˙.BYTE ˙0 ASGN5: ˙.ASCII ˙/ ˙$POP/ ˙.BYTE ˙0 ˙.EVEN ˙.END śDATV31 ;NOT DIMENSIONED => SIMPLE 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,ˇ ;CALLED AT END OF DECLARATIONS ; ;REGISTER USAGE: ;R0-FOLLOWS BLOCK CHAIN ;R1-FOLLOWS SUBBLOCK CHAIN ;R2-FOLLOWS 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,AL¸(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,R4 ˙BR ˙LABEY ; ; HDRGEN - HEADER GENERATOR AND P şR3 ˙;COMPENSATE FOR ELEMENT SIZE ˙JSR ˙PC,OUTOCT ˙RTS ˙PC ;CASE 3: WHOLE ARRAY 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" ťOC20 ˙;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 ; ; ENDING COMES HERE ; ALOC99: ˙JSR ˙R5,OUTLN2 ˙;".CSECT" ˙ALOC81 ˙JSR ˙PC,EOL ALOC98: ˙RTS ˙PC ˙ ˙;AND EXIT ; DO CSECT POINTED TO BY R0 ; ALOC20: ˙CLR ˙-(SP) ˙ ˙;COUNTER WITHIN CSECT BYTES ˙JSR ˙PC,OUTCST ; PźROTOTYPES. 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 ˙;NAME ˙JS˝; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙EVL039 ˙.GLOBL ˙PARXMK,LIST99 ˙.GLOBL ˙ARY001,EXPGEN,SUBEXP,ASGN8,GL1,CALL03 ˙.GLOBL ˙ASGN9,STKCNT,CKOP,PLUS,MINUS,NXTCH,CHTEST ˙.GLOBL ˙ARYASG,IOL,NOT,GET,PWR,LT,GE,TEMP ˙.GLOBL ˙CURSYM,PARMKM,PARWD,FLABL,SERATR,PUTNAM ˙.GLOBL ˙BITM,MISž ; ˙DATVEN ; ; CALLED AT END OF CONSTANT TO CLOSE OFF VARIABLE ; DATVEN: ˙TST ˙DATVCT ˙BNE ˙DATVE3 ˙ ˙;BR => STILL ON ARRAY ˙MOV ˙DATLAB,R3 ˙;IS THERE A LABEL? ˙BEQ ˙DATVE1 ˙ ˙;BR => NO ; ; HAVE ITEM ALLOCATED IN NON-COMMON (CASE II) ; ˙CLR ˙DATLAB ˙MOV ˙#DATVE9,R4 ˙JSR ˙PC,OUTLN1 ˙MOV ˙#'F,R0 ˙JSR ˙PC,OUTSER ˙JSR ˙PC,EOL DATVE2: ˙RTS ˙PC ˙ ˙;(CASE I) ; DATVE1: ˙MOV ˙DATVSV,R0 ˙ADD ˙SYMBAS,R0 ˙TSTB ˙COMNWżUT 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: ˙TST ˙(R2)+ ˙ ˙;ADVANCE R2 ˙MOV ˙@R2,R4 ˙ ˙;ST LINK ˙BEQ ˙ALOC03 ˙ ˙;ZERO = > END OF SUBBLOCK ˙MOV ˙R0,-(SP) ˙MOV ˙R4,R0 ˙ADD ˙SYMBAS,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ŔR ˙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 ÁC,OUTGL,EOL,OUTNAM,OUTCOM,OUTSER ˙.GLOBL ˙OUTTAB,PUTCHR,CHR,CV1,EXPMAP,GL2,FNSTK,ENTYWD ˙.GLOBL ˙OUTLN1,OUTST,OUTOCT,CALL05,OUTCHR ˙.GLOBL ˙OUTCH2,OUTLN2,ARY004,FUNC13,FUN000 ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; SPACE ˙= ˙40 TAB ˙= ˙11 MODE ˙= ˙60 OP ˙= ˙20 ; ; FORTRAN EXPRESSION PROCESSING PACKAGE ; ; ; SUBEXP - CONVERTS A STRING OF ASCII POINTED TO BY ; ˙R1 INTO AN INTERNAL POLISH STRING WITH ; ˙EXPLICIT MODE DESCRIPTIONSÂD(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 ˙JSR ˙PC,OUTOCT ˙JSR ˙PC,EOL DATVE3: ˙RTS ˙PC ; DATVE9: ˙.BYTE ˙'.,TAB,'=,0 ˙.EVEN ; ˙DATCON ; ;SUPPLY A CONSTANT FOR A DATA STATEMENT ; DATCON: ˙TST ˙DATCCT ˙ ˙Ă 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 ABOVE ROUTINE SINCE SO SIMILAR)***** ; ; ˙INPUT - R0 = POINTER TO CSECT NAME IN COMMON TABLES ; ˙ R1 = STEX OF VARIABLE ; ˙OUTPUT - R0 = DISPLACEMENT Ĺ. UPON RETURN, ALL OF THE ; ˙POLISH GOODIES ARE ON THE STACK WITH R0 POINTING TO ; ˙THE START AND SP POINTING TO THE END. ; ˙ALSO, R2 HAS IN BITS 12-15 THE TYPE OF THE ; ˙POLISH RESULT. THE POLISH LIST WILL ALWAYS BE ; ˙TERMINATED BY A ZERO WORD. ; ; ; ˙REGISTERS CHANGED - R0,R1,R2,R3,R4,R5. ; ASGN9A: ˙JMP ˙ASGN9 SUBEXP: ˙MOV ˙SP,R5 ˙ ˙;SET UP ˙SUB ˙#MODE,SP ˙ ˙; MODE LIST ˙MOV ˙SP,R4 ˙ ˙;SET UP ˙SuB ˙#OP,SP ˙ ˙;OPERATOR LIST ˙CLR ˙-(R4) ˙ ˙;SET PRIORITY ZERO OP ˙MOV ˙SP,STKCNT ˙;REĆ;ARE WE REPEATING? ˙BEQ ˙DATC01 ˙ ˙;BR=> NO ;USE THE PREVIOUS 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 ˙#'Z,@R1 ˙ ˙;LOOK FOR HEX CONSTANT ˙BEQ ˙DATHEX ˙CMPB ˙#'-,@R1 ˙ ˙;CHECK FOR UNARYÇ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: ˙TST ˙(R2)+ ˙MOV ˙@R2,R4 ˙ ˙;STEX FROM COMMON BLOCK ˙BEQ ˙ALOX03 ˙;NOT REALLY - LOOK FOR LINK ˙CMP ˙R1,R4 ˙ ˙;MATCH YET? ˙BEQ ˙ALOX06 ˙ ˙;BR => NORMAL EXIT ˙JSR ˙PC,SIZESN ˙;INCLUDE THIS ELEMENT Č; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙IOSTMT ˙.GLOBL ˙GL1,PUTCHR,OUTCH2,OUTLN2 ˙.GLOBL ˙END1,GET,ZLEQLS,GENLAB,NXTCH ˙.GLOBL ˙PUTNAM,BITM,MISC,OUTGL,EOL ˙.GLOBL ˙OUTNAM,OUTCOM,CURSYM,OUTST,OUTLN1 ˙.GLOBL ˙OUTCHR,PARMKM,PARWD,PARXWD,OUTSER ˙.GLOBL ˙PARCNT,DOTMP,DONUM,LINENO,DÉMEMBER POLISH START SUBEX1: ˙JSR ˙PC,CKOP ˙ ˙;GO SEE IF A UNARY EXISTS ˙BVS ˙SUB003 ˙ ˙;NO UNARY FOUND ˙CMP ˙PLUS,R0 ˙ ˙;IS IT A PLUS?? ˙BEQ ˙SUB003 ˙ ˙;IF IT IS, IGNORE IT ˙CMP ˙MINUS,R0 ˙ ˙;IS IT A UNARY MINUS? ˙BNE ˙SUB002 ˙ ˙;NO ˙MOV ˙#004407,R0 ˙;YES, SET UNARY MINUS SUB013: ˙MOV ˙R0,-(R4) ˙;PLACE OPERATOR IN LIST ˙BR ˙SUB003 ; ; THIS CODE FIGURES OUT PARENTHESIZED EXPRESSIONS ; SUB036: ˙MOV ˙R4,-(SP) ˙;SAVE ˙MOV ˙Ę 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 ˙DATCË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 ; OUTCSX: 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 ; ALOC80: ˙.ASCII ˙'=.+' ˙.BYTE ˙0 ALOC81: ˙.BYTE ˙TAB ˙.ASCII ˙'.CSECT' ˙.BYTE ˙TAB,0 ALOC82: ĚODON ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; TAB ˙= ˙11 ; ; THE FOLLOWING CODE HANDLES READ, WRITE, PRINT, AND FIND ; ˙STATEMENTS. ALL REGISTERS ARE USED. ; ˙.GLOBL ˙SCAN2A,OUTSL ˙˙.GLOBL ˙READ,WRITE,FIND,PRINT SPIO: ˙TST ˙@SP ˙;IS IT A READ? ˙BNE ˙BADIO ˙ ˙;NO ˙MOV ˙#2,@SP ˙ ˙;YES, READ IS SIMPLE FORM ˙DEC ˙R1 ˙ ˙;BACK UP CHARACTER POINTER ˙MOV ˙R1,-(SP) ˙;AND SAVE IT ˙MOV ˙#RDDEV,R1 ˙;GET FAKE UNIT NUMBER IO018: ˙JSR ˙PC,ÍR5,-(SP) ˙;THE LOCAL GOODIES ˙MOV ˙STKCNT,-(SP) ˙;VERY CAREFULLY ˙JSR ˙PC,SUBEXP ˙;NOW FIGURE OUT WHATS INSIDE ˙TST ˙(R0)+ ˙ ˙;BACK UP THE POINTER ˙MOV ˙R0,R3 ˙ ˙;REMEMBER WHERE POLISH STARTS ˙MOV ˙(R0)+,STKCNT ˙;RESTORE ˙MOV ˙(R0)+,R5 ˙;THE LOCAL ˙MOV ˙(R0)+,R4 ˙;GOODIES SUB10A: ˙CMPB ˙(R1)+,#' ˙;SKIP OVER ˙BEQ ˙SUB10A ˙ ˙; BLANKS ˙DEC ˙R1 ˙ ˙;NOW BACK UP POINTER TO PROPER PLACE ˙CMPB ˙(R1)+,#') ˙;IS THERE A MATCHING PAREN??? ˙BEQ ˙SUB010 ˙ ˙;YES ˙DEC ˙R1 ˙ ˙;NO,GIVE A DIAGNOSTIÎ92 ˙ ˙;BR=> COUNT OF ZERO OR LESS ˙MOV ˙R0,DATCCT ˙;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 ˙#'+,@R1 ˙BNE ˙DATC07 ˙INC ˙R1 DATC07: ˙JSR ˙PC,GET DATC06: ˙BVS ˙DATC91 ˙ ˙;PUNT ON ERROR ˙TST ˙R3 ˙ ˙BGE ˙DATC9Ď˙.ASCII ˙'.=.+' ˙.BYTE ˙0 TAB=11 CR=15 LF=12 BLANKC: ˙.ASCII ˙'.$$$$.' ˙.BYTE ˙0 ˙.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 => ALL OKAY ; SIZXSM: SIZESM: ˙MOV ˙R0,-(SP)ĐGET ˙ ˙;PLACE IT IN SYMBOL TABLE ˙MOV ˙(SP)+,R1 ˙;RESTORE REGULAR TEXT POINTER ˙BR ˙IO002 ˙ ˙;RETURN TO HANDLER RDDEV: ˙.BYTE ˙'4,0 ˙ ˙;UNIT 4 FOR SPECIAL INPUT PRINT: ˙JSR ˙PC,ZLEQLS ˙;IS THIS A PRINT STATEMENT? ˙BCS ˙NOIO1 ˙ ˙;NO ˙MOV ˙#3,-(SP) ˙;SET SPECIAL WRITE ˙MOV ˙R1,-(SP) ˙;SAVE R1 ˙MOV ˙#WTDEV,R1 ˙;GET ADDRESS OF FUNNY WRITE DEVICE ˙BR ˙IO018 ˙;GO PROCESS IT WTDEV: ˙.BYTE ˙'5,0 ˙ ˙;UNIT 5 FOR SPECIAL OUTPUT NOTIO: ˙TST ˙(SP)+ ˙ ˙;DISCARD SCRAP NOIO1: ˙SEV ˙ ˙ ˙;SET ERROR ˙RTŃC AND ˙TRAP+25. ˙ ˙ ˙;BACK UP OVER THE BAD CHARACTER SUB010: ˙MOV ˙-(R3),-(R0) ˙;NOW PACK THE POLISH IN ˙BNE ˙SUB010 ˙ ˙;REAL TIGHT ˙TST ˙(R0)+ ˙ ˙;DISCARD THE ZERO WORD ˙MOV ˙R0,SP ˙ ˙;RE-FUDGE THE STACK ˙MOV ˙STKCNT,R3 ˙;COMPUTE ˙SUB ˙SP,R3 ˙ ˙;THE NEW RESULT POSITION ˙TST ˙ARYASG ˙ ˙;IS THIS A SUBSCRIPT ˙BNE ˙ASGN9A ˙ ˙;ON THE LEFT SIDE OF AN EQUAL??YES ˙TST ˙IOL ˙ ˙;IS THIS AN I/O LIST? ˙BNE ˙ASGN9B ˙ ˙;YES ˙BR ˙SUB011 ˙ ˙;FALL BACK INTO MAIN LOOP ASGN9B: ˙JMP ˙LIST99 ; NOW, WŇ1 ˙ ˙;NOT A CONSTANT DATC03: ˙MOV ˙CURSYM,DATCSV ˙; ˙SUB ˙SYMBAS,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 ; ;FUDGE UP A COMPLEX CONSTANÓ ˙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 LIMÔS ˙PC ˙ ˙;AND RETURN ; READ: ˙CLR ˙-(SP) ˙ ˙;SET READ MODE ˙BR ˙IOCOM ˙ ˙;GO DO COMMON I/O HANDLING ; WRITE: ˙MOV ˙#1,-(SP) ˙;SET WRITE MODE ˙BR ˙IOCOM ˙ ˙;GO TO COMMON HUNK OF CODE ; FIND: ˙MOV ˙#-1,-(SP) ˙;SET FIND MODE ; IOCOM: ˙JSR ˙PC,ZLEQLS ˙;IS IT A REAL I/O STATEMENT?? ˙BCS ˙NOTIO ˙ ˙;NO, GO TRY FOR ASSIGNMENT ˙JSR ˙PC,GENLAB ˙;GENERATE THE LABEL ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#'( ˙ ˙;IS IT A LEFT PAREN? ˙BNE ˙SPIO ˙ ˙;NO, GO CHECK SPECIAL READ, PRINT ˙JSR ˙PC,GŐASN'T THAT PAINLESS????? ; ; ; ; CONTINUE THE STATEMENT PROCESSING ; SUB002: ˙CMP ˙NOT,R0 ˙ ˙;IS IT A .NOT. ??? ˙BEQ ˙SUB013 ˙ ˙;YES, PUT AWAY AND CONTINUE ˙TRAP+8. ˙ ˙ ˙;ILLEGAL UNARY SUB003: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#'( ˙ ˙;IS IT A PAREN?? ˙BEQ ˙SUB036 ˙ ˙;YES ˙DEC ˙R1 ˙ ˙;NO, BACK UP POINTER ˙JSR ˙PC,GET ˙ ˙;NOW TRY FOR AN OPERAND ˙BVS ˙SUB035 SUB015: ˙TST ˙R3 ˙ ˙;CHECK MODE ˙BGT ˙SUB006 ˙ ˙;SPECIÖT ; DATC10: ˙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,DATC×IT ;READY TO 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 ; SIZXSN: SIZESN: ˙ADD ˙SYMBAS,R4 ˙MOV ˙ADBPWD(R4),R3 ˙;ADB WORD ˙BEQ ˙SIZES5 ˙ ŘET ˙ ˙;GET THE UNIT NUMBER ˙BVS ˙BADIO ˙ ˙;NO UNIT NUMBER ˙CMP ˙R2,#2 ˙ ˙;IS IT AN INTEGER?? ˙BEQ ˙IO001 ˙ ˙;YES ˙TRAP+65. ˙ ˙;NO, GIVE ERROR IO001: ˙CMP ˙R3,#1 ˙ ˙;IS IT A VARIABLE OR CONSTANT ˙BLE ˙IO002 ˙ ˙;YES, IT IS ˙TRAP+66. ˙ ˙;ARRAY OR FUNCTION NAME IS ILLEGAL IO002: ˙JSR ˙PC,PVAR ˙ ˙;GENERATE PUSH ˙CMP ˙@SP,#2 ˙ ˙;IS IT A SPECIAL READ OR WRITE?? ˙BGE ˙IO006 ˙ ˙;YES ˙JSR ˙PC,NXTCH ˙;GET A COMMA ˙CMPB ˙R2,#', ˙ ˙; WAS IT A COMMA? ˙BEQ ˙IO005 ˙ ˙; YES,GO GET GOODIES ˙CMPB ŮAL HANDLING FOR ARRAY OR FUNCTION SUB007: ˙MOV ˙R0,-(SP) ˙;PLACE ON POLISH LIST AND ˙ ˙ ˙ ˙;SET MODE SUB009: ˙MOV ˙STKCNT,R3 ˙;COMPUTE ˙SUB ˙SP,R3 ˙ ˙;POSITION ˙BIC ˙#177770,R2 ˙;ON POLISH LIST AND ; THE FOLLOWING THREE LINES ARE PROBABLY TEMPORARY ˙CMPB ˙R2,#6 ˙ ˙;IS IT ASCII MODE? ˙BNE ˙SUB09A ˙ ˙;NO ˙MOV ˙#2,R2 ˙ ˙;YES, PRETEND IT IS INTEGER SUB09A: ˙SWAB ˙R2 ˙ ˙;REMEMBER ˙ASL ˙R2 ˙ASL ˙R2 ˙ ˙;THE ˙ASL ˙R2 ˙ ˙;MODE ˙ASL ˙R2 ˙ ˙;TOO SUB011: ˙BIS ˙R2,R3 ˙ ˙;STORE MODE IN BITS 13-ÚCT,BLKDAT,DATVST,DATTYP ˙.GLOBL ˙DATVSV,FLABL,DATADB,DATA,ALOCAT ˙.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 CONSŰ˙;LEAVE ZERO AS ZERO ˙ADD ˙SYMBAS,R3 SIZES5: ˙BR ˙SIZESM ; ; 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 Ü˙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 ˙CCC ˙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 ˙BR ˙IOGEN ˙ ˙;GO HANDLE ALL THE COMMON GOODIES IO005: ˙MOV ˙R1,R5 ˙Ý15 ˙MOV ˙R3,-(R5) ˙;SAVE IN THE MODE LIST ˙JSR ˙PC,CKOP ˙ ˙;GET AN OPERATOR ˙BVS ˙SUB012 ˙ ˙;SPECIAL CHECK IF NO OPERATOR ˙CMP ˙R0,NOT ˙ ˙;IS IT A NOT?? ˙BNE ˙SUB005 ˙;NO ˙TRAP+79. ˙ ˙;YES, GIVE ERROR DIAGNOSTIC SUB005: ˙MOV ˙R0,-(R4) ˙;GET THE PRIORITY ˙CMPB ˙(R4),2(R4) ˙;COMPARE CURRENT PRIORITY ˙ ˙ ˙ ˙;TO PREVIOUS ˙BGT ˙SUBEX1 ˙ ˙;JUMP IF HIGHER ˙TST ˙@R4 ˙ ˙;IS THIS ITEM THE END? ˙BEQ ˙SUB039 ˙ ˙;YES ˙TST ˙2(R4) ˙ ˙;NO, IS THIS THE ONLY ENTRY? ˙BEQ ˙SUBEX1 ˙ ˙;YES, PRETEND IŢTANT BUT FIRST CHECK THAT ; ˙THE TYPE MATCHES THAT OF THE VARIABLE BEING PRESET ; OUTCOC: ˙MOV ˙DATYWD(R4),R2 ˙;TYPE WORD OF CONST TO R2 ˙BIC ˙#DATYMK,R2 ˙;CLEAR ALL BUT TYPE BITS ˙BIC ˙#DATYMK,DATTYP ˙;LIKEWISE TO VARIABLE TYPE WORD ˙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 ˙TRAP+107. ˙ ˙;"MISMATCHED DATA TYPES" OUTCC2: ˙JSR ˙PC,OUTCON ˙;OUß; ˙SIZESQ ; ; SIMILIAR TP SIZESM EXCEPT THAT AN ELEMENT ; SIZE OF ONE 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 ; SIZXSQ: 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ŕ ˙;SAVE TEXT POINTER ˙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 ˙.GLOBL ˙NOCNSV ˙INCB ˙NOCNSV ˙ ˙;SUPRESS 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 áT HAS HIGH PRIORITY SUB039: ˙TST ˙(R4)+ ˙ ˙;DISCARD ENTRY MADE IN HASTE ˙SWAB ˙@R4 ˙ ˙;MOVE THE OPERATOR BITS ˙CLRB ˙1(R4) ˙ ˙;AND MAKE ROOM FOR THE MODE FLAG ˙MOV ˙(R4)+,-(SP) ˙;GET THE HIGHER OPERATOR ˙BEQ ˙SUB037 ˙ ˙;ALL DONE ˙BIS ˙#100000,@SP ˙;SET OPERATOR FLAG ˙CMPB ˙@SP,PWR+1 ˙;IS IT EXPONENTIATION? ˙BEQ ˙SUB017 ˙ ˙;YES ˙CMPB ˙@SP,NOT+1 ˙;CHECK FOR NOT ˙BEQ ˙SUB041 ˙ ˙;IT IS ONE ˙CMPB ˙@SP,#11 ˙ ˙;ALSO CHECK FOR UNARY MINUS ˙BNE ˙SUB040 ˙ ˙;IT ISN'T ONE SUB041: ˙MOV ˙@R5,-(RâTPUT CONSTANT ; ; HERE WORRY ABOUT 2 VS 4 BYTE INTEGERS AND LOGICALS ; IF VARIABLE TYPE IS INTEGER OR LOGICAL-2 THEN ; MORE CHECKING FOLLOWS. ; ˙CMP ˙#10000,DATTYP ˙;INTEGER TYPE? ˙BEQ ˙OUTCC4 ˙ ˙;BR => YES ˙CMP ˙#4000,DATTYP ˙;LOGICAL-2 TYPE? ˙BEQ ˙OUTCC4 ˙ ˙;BR => YES ; NOT LOGICAL-2 OR INTEGER SO JUST RETURN ˙RTS ˙PC ˙ ˙;EXIT WITH JOB WELL DONE ; IF TYPSIZ TABLE INDICATES 4 BYTES FOR ; INTEGERS THEN WE NEED TO PAD THE CONSTANT JUST PUT ; OUT WITH A ZERO WORD ; OUTCC4:ă ˙BR ˙SIZES1 ˙ ˙;JUMP INTO THE ARRAY CASE CODE ; ˙SIZT ; ; COMPUTE OFFSET OF A SUBSCRIPT AT COMPILE TIME ; 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 EXä ˙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 ˙JSR ˙R5,OUTLN2 ˙INIT07 ˙JSR ˙R5,OUTCH2 ˙'$ ˙JSR ˙PC,OUTSL ˙;OUTPUT THE FORMAT NUMBER ˙BVS ˙IO007 ˙ ˙;ERROR OF NO NUMBER ˙MOV ˙#FMTLB1,R4 ˙;OUTPUT NORMAL TERMINATOR 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 ĺ5) ˙;FAKE OUT THE MODE LIST SUB040: ˙CMP ˙@R5,2(R5) ˙;CHECK FOR MODE OF OPERATIONS ˙BLT ˙SUB019 ˙ ˙;FIRST IS HIGHER THAN SECOND ˙MOV ˙(R5)+,R3 ˙;SECOND IS HIGHER THAN FIRST SUB020: ˙BIC ˙#007777,R3 ˙;CLEAR POSITION INFORMATION FOR MODE ˙BIC ˙#170000,@R5 ˙;GET DISPLACEMENT ˙MOV ˙STKCNT,R2 ˙;GET THE ADDRESS ˙SUB ˙@R5,R2 ˙;OF THE ELEMENT ˙BIS ˙R3,@R2 ˙ ˙;FORCE A MODE CONVERSION ˙ADD ˙(R5)+,R2 ˙;COMPUTE SUB033: ˙SUB ˙SP,R2 ˙ ˙;POSITION OF RESULT ˙CMPB ˙@SP,LT+1 ˙;IS THIS ˙BLT ˙SUB33A ˙ ˙;ć ˙CMPB ˙#4,TYPSIZ+2 ˙;INTEGER IS TYPE 2 ˙BNE ˙OUTCC5 ˙ ˙;NOT SO, JUST EXIT ˙MOV ˙#OUTCC6,R4 ˙;"0" ˙JSR ˙PC,OUTLN1 OUTCC5: ˙RTS ˙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: ˙MOV ˙DATTYP,R3 ˙;GET VARIABLE ˙SWAB ˙R3 ˙ ˙;BYTE SIZE BY THIS ˙ROR ˙R3 ˙ ˙;MESSY ARRANGEMENT ˙RçCEEDED 16 BITS ; SIZXT: SIZT: ˙MOV ˙R0,-(SP) ˙;SAVE ˙MOV ˙R1,-(SP) ˙MOV ˙R2,-(SP) ˙MOV ˙R4,-(SP) ˙ ˙MOV ˙R4,R1 ˙ ˙;FOR EQVBDS ˙JSR ˙PC,EQVBDS ˙;CHECK THAT SUBSCRIPTS IN BOUNDS ˙BCS ˙SIZT02 ˙ ˙;BR => OUT OF BOUNDS ˙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 ˙ ˙č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 ˙RTS ˙PC ˙ ˙;RICHARD R. M. IO011: ˙TST ˙R3 ˙ ˙;IS IT A VARIABLE OR CONSTANT? ˙BGT ˙IO012 ˙ ˙;NO ˙CMP ˙R2,#2 ˙;IS IT INTEGER? ˙BNE ˙IO012 ˙ ˙;NO ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE ˙INIT07 ˙MOV ˙CURSYM,R0 ˙;SYMBOL ˙JSR ˙PC,OUTST ˙;NAME ˙JSR ˙PC,EOL IO014: ˙CMP ˙@PC,2(SP) ˙;IS THéOPERATION ˙CMPB ˙@SP,GE+1 ˙;ONE WHICH HAS ˙BGT ˙SUB33A ˙ ˙;A TYPE LOGICAL RESULT? ˙MOV ˙#010000,R3 ˙;YES, SET TO LOGICAL RESULT SUB33A: ˙BIS ˙R3,R2 ˙ ˙;ADD MODE ˙MOV ˙R2,-(R5) ˙;PLACE IN MODE LIST ˙BR ˙SUB005 ˙ ˙;AND RE-LOOP SUB019: ˙MOV ˙˙(R5)+,R2 ˙;PICK ˙MOV ˙(R5)+,R3 ˙;UP ˙MOV ˙R2,-(R5) ˙;MODES ˙BR ˙SUB020 ˙ ˙;IN REVERSE ORDER SUB017: ˙MOV ˙(R5)+,R3 ˙;GET SECOND ITEM(EXPONENT) ˙MOV ˙@R5,R2 ˙ ˙;GET BASE ˙BIC ˙#007777,R3 ˙;CLEAR JUNK BITS ˙BIC ˙#007777,R2 ˙CMP ˙R3,#20000 ˙;IS TęOR ˙R3 ˙ROR ˙R3 ; GUARENTEE THAT TWO ASCII BYTES ARE USED FOR INTEGER ; AND LOGICAL REGARDLESS OF ALLOCATED SIZE ˙CMP ˙#2,R3 ˙ ˙;INTEGER TYPE ˙BEQ ˙OUTCD2 ˙CMP ˙#1,R3 ˙ ˙;LOGICAL*2 ˙BEQ ˙OUTCD2 ˙MOVB ˙TYPSIZ(R3),R3 ˙JSR ˙PC,OUTCD1 ˙RTS ˙PC ; OUTCD2: ˙MOV ˙#2,R3 ˙JSR ˙PC,OUTCD1 ˙BR ˙OUTCC4 ;GET DATA SIZE OUTCD1: ˙MOV ˙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 ; FOLLOë;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 ˙ADD ˙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 SIZTěE 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 ˙TRAP+85. ˙ ˙;NO, ERROR ˙BR ˙IO013 IO017: ˙MOVB ˙#'),R2 ˙ ˙;PRETEND IT IS NORMAL READ OR WRITE ˙BR ˙IOGEN ˙ ˙;GO HANDLE REST OF STUFF IO016: ˙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íHE EXPONENT INTEGER? ˙BGT ˙SUB028 ˙ ˙;NO ˙BEQ ˙SUB029 ˙ ˙;YES ˙TRAP+80. ˙ ˙;BYTE OR LOGICAL EXPONENT NOT ALLOWED SUB029: ˙MOV ˙R2,R3 ˙ ˙;GET MODE OF BASE SUB045: ˙MOV ˙STKCNT,R2 ˙;GO BACK ˙TST ˙-(R2) ˙ ˙;FUDGE STKCNT FOR BENEFIT OF EXPONENTIATION ˙MOV ˙(R5)+,-(SP) ˙;SAVE THE BASE TYPE ˙SUB ˙SP,R2 ˙ ˙;POSITION OF RESULT ˙BR ˙SUB33A SUB028: ˙CMP ˙R3,#40000 ˙;IS IT DOUBLE OR COMPLEX? ˙BGE ˙SUB031 ˙ ˙;YES SUB032: ˙CMP ˙R2,#30000 ˙;IS IT REAL, DOUBLE, ETC. ˙BGE ˙SUB030 ˙ ˙;YES ˙TRAP+81.îWING 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 ; ˙OUTCON ; ; OUTPUT A CONSTANT FROM THE SYMBOL TABLE AS A ; SERIES OF WORDS IN OCTAL ; ; ď01: ˙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 ˙CLC SIZT03: ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R0 ˙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đ ˙ ˙;JUMP IF OK ˙TRAP+70. ˙ ˙;GIVE MISSING PAREN ERROR ˙BR ˙IO013 ; ; 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 ; IOGEN:ń ˙ ˙;I**R NOT LEGAL SUB030: ˙CMP ˙R2,#50000 ˙;IS IT COMPLEX? ˙BLT ˙SUB029 ˙ ˙;NO SUB046: ˙TRAP+82. ˙ ˙;YES, C**R NOT ALLOWED ˙BR ˙SUB029 SUB031: ˙BEQ ˙SUB034 ˙ ˙;COUBLE ˙TRAP+84. ˙ ˙;ERROR IF COMPLEX ˙BR ˙SUB034 SUB035: ˙TRAP+41 ˙ ˙ ˙;ILLEGAL OPERAND ˙MOV ˙R1,-(SP) ˙;SAVE CURRENT TEXT POINTER ˙MOV ˙#FAKE,R1 ˙;GET FAKE STRING POINTER ˙JSR ˙PC,GET ˙ ˙;GET A FAKE OPERAND ˙MOV ˙(SP)+,R1 ˙;RESTORE REAL POINTER ˙BR ˙SUB015 ˙ ˙;RETURN TO REAL WORLD FAKE: ˙.BYTE ˙'1,0 SUB006: ˙CMP ˙R3,#2 ˙ňINPUT: R4 - SYMBOL TABLE ENTRY ADDRESS ; REGISTERS CHANGED: R3,R4,R5 ; OUTCON: ˙MOV ˙R4,-(SP) ˙MOV ˙#OUTCO1,R4 ˙JSR ˙PC,OUTLN1 ˙;" .WORD " ˙MOV ˙(SP)+,R4 ˙MOV ˙@R4,R5 ˙BIC ˙#177400,R5 ˙;#BYTES ˙INC ˙R5 ˙ ˙;CONVERT BYTE COUNT TO ˙CLC ˙ ˙ ˙;WORD COUNT BY ROUNDING UP ˙ROR ˙R5 ˙ADD ˙#SYMBYT,R4 ˙;BEGINNING OF CONST OUTCO2: ˙MOV ˙(R4)+,R3 ˙JSR ˙PC,OUTOCT ˙DEC ˙R5 ˙BGT ˙OUTCO3 ˙JSR ˙PC,EOL ˙RTS ˙PC ; OUTCO3: ˙MOV ˙R4,-(SP) ˙;SAVE STE POINTER ˙MOV ˙#',,R4 ˙JSR ˙PCó R0 ;IF OVERFLOW SET C ;AND RETURN (R0) = 0 IMULTI: ˙TST ˙R1 ˙BEQ ˙IMULT4 ˙MOV ˙R5,-(SP) ˙;SAVE R5 ˙MOV ˙R0,R5 ˙ ˙;ORIGINAL VALUE IMULT1: ˙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 ˙ZLEô ˙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: ˙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 INő ˙;IS IT A FUNCTION NAME???? ˙BLT ˙ARY000 ˙ ˙;NO, TRY FOR ARRAY ˙.GLOBL ˙TFUN ˙JSR ˙PC,TFUN ˙ ˙;GO TEST FUNCTION TYPE ˙JSR ˙PC,FUN000 ˙;GO PROCESS A FUNCTION ˙TST ˙(SP)+ ˙ ˙;REMOVE TERMINATOR ˙JMP ˙SUB009 ˙ ˙;RETURN AND SET TYPE SUB012: ˙˙CLR ˙R0 ˙ ˙; END OF STRING ˙BR ˙SUB005 ˙ ˙;GO DO FINAL PROCESSING SUB034: ˙CMP ˙R2,#30000 ˙BGE ˙SUB044 ˙TRAP+81. ˙ ˙;I**D NO GOOD SUB044: ˙CMP ˙R2,#50000 ˙BLT ˙SUB045 ˙ ˙;R**D OR D**D OK ˙BR ˙SUB046 ˙ ˙;C**D NO GOOD ö,OUTCHR ˙MOV ˙(SP)+,R4 ˙;RESTORE STE POINTER ˙BR ˙OUTCO2 ; ; OUTCO1: ˙.BYTE ˙TAB ˙.ASCII ˙'.WORD' ˙.BYTE ˙TAB,0 ˙.EVEN ; ; ˙GETOCT ; ; COLLECT AN OCTAL CONSTANT AND FORM A ; (FAKE) SYMBOL TABLE ENTRY ; GETOCT: ˙CLR ˙-(SP) ˙ ˙;FLAG CELL FOR ERRORS ˙CLR ˙R0 ˙ ˙;DEVELOP 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 ˙÷QLS,EQVHED,NXTCH,CNXC ˙.GLOBL ˙COMNXT,EQUIVA,LSTITM,COMHGH ˙.GLOBL ˙ADJWD,ADJMKM,OUTCHR,OUTSER ˙.GLOBL ˙FLABL,ALLMKM,ALLOWD ; ˙EQUIVA ; ;EQUIVALENCE HANDLER - INPUT PHASE ; EQUIVA: ˙TSTB ˙ALOKAT ˙BNE ˙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,-(SřDICATOR 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 HAD ONE ˙BNE ˙IOG03 ˙BISB ˙BITM(R5),MISC+2 ˙;SET FOUND BIT ˙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ů; ; END PROCESSING FOR POLISH SUBEXPRESSION HANDLER ; SUB037: ˙MOV ˙(R5)+,R2 ˙;GET THE FINAL MODE INFORMATION ˙BIC ˙#007777,R2 ˙;CLEAR JUNK FROM TYPE ˙MOV ˙R5,R0 ˙ ˙;GET FUTURE DATA ADDRESS ˙MOV ˙(R5)+,R3 ˙˙;GET THE RETURN ADDRESS ˙MOV ˙STKCNT,R4 ˙;GET FIRST DATA ADDRESS SUB038: ˙MOV ˙-(R4),-(R5) ˙;TRANSFER THE GOODIES ˙BNE ˙SUB038 ˙ ˙;UNTIL A TERMINATOR IS FOUND ˙MOV ˙R5,SP ˙ ˙;RESET STACK ˙JMP ˙@R3 ˙ ˙;RETURN TO CALLER ú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 ˙BVS ˙GETHE8 ˙CLC ˙ROL ˙R0 ˙BCS ˙GETHE9 ˙ROL ˙R0 ˙BCS ˙GETHE9 ˙ROL ˙R0 ˙BCS ˙GETHE9 ˙ROL ˙R0 ˙BCS ˙GETHE9 ˙ADD ˙R5,R0 ˙BR ˙GETHE1 GETHEűP) ˙;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 COME ˙BEQ ˙EQUI03 ˙BR ˙EQUI06 ˙ ˙;ERROR ; ;EXITS ; EQUI04: ˙TST ˙(SP)+ ˙ ˙;CLEAR STACK ˙BR ˙EQUI05 EQUI06: ˙TRAP+60. ˙ ˙;"ILLEGAL EQV GROUP DELIMITER" EQUI05: ˙CLC ˙RTS ˙PC ü,OUTLN2 ˙;YES, OUTPUT A NULL LIST ˙INIT05 IOG14: ˙TST ˙(SP)+ ˙ ˙;IS IT "FIND"?? ˙BPL ˙LISTPR ˙ ˙;NO ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙TST ˙R2 ˙ ˙;IS THIS THE END OF LINE?? ˙BEQ ˙IOG13 ˙ ˙;YES ˙TRAP+12. ˙ ˙;NO SO GIVE ERROR IOG13: ˙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 ý; ; SUBROUTINE TO HANDLE ALL ARRAY SEQUENCES ; ARY000: ˙TST ˙ARYASG ˙BEQ ˙ARY004 ˙TRAP+32. ˙ ˙;ILLEGAL SUBSCRIPT IN ARRAY REF. ARY004: ˙MOV ˙R2,-(SP) ˙;PLACE TYPE ON STACK ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#'( ˙ ˙;IS THIS A NORMAL ARRAY REFERENCE? ˙BEQ ˙ARY001 ˙ ˙;YES ˙MOV ˙(SP)+,R2 ˙;GET TYPE ˙DEC ˙R1 ˙ ˙;NO ˙TST ˙ARYASG ˙ ˙;CHECK FOR LEFT SIDE OF ASSIGNMENT ˙BEQ ˙ARY040 ˙ ˙;ISN'T, SO HANDLE NORMALLY ˙JMP ˙ASGN8 ˙ ˙;ALTERNATE EXIT ARY04ţ9: ˙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 ; ˙GCMPLX ; ;ATTEMPT TO COLLECT A COMPLEX CONSTANT OF THE ;FORM: ; ˙(REAL,REAL) ; ˙ ^ ;ENTER WITH R1 POINTI˙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: ˙MOV ˙COMNXT,R0 ˙MOV ˙R0,-(SP) ˙;SAVE BEGIN OF GROUP ˙JSR ˙PC,NXTCH ˙CMPB ˙#'(,R2 ˙ ˙; ˙BNE ˙EQUG09 ˙ ˙;NO INITIAL ( ˙CLR ˙(R0)+ ˙ ˙;LINK TO NEXT GROUP ˙CLR ˙(R0)+ ˙ ˙;GROUP FLOATING BASE 'FLT' ˙MOV ˙R0,-(SP) ˙JSR ˙P˙;YES, OUTPUT ˙'. ˙JSR ˙PC,OUTSL ˙;THE LABEL ˙BVS ˙IOG09 ˙JSR ˙PC,OUTCOM ˙;NOW OUTPUT A COMMA ˙JSR ˙PC,NXTCH ˙;GET THE 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 N0: ˙JMP ˙SUB007 ˙ ˙;HANDLE LIKE SIMPLE VARIABLE ARY001: ˙MOV ˙R0,-(SP) ˙;REMEMBER SERIAL NUMBER ˙MOV ˙R4,-(SP) ˙;AND VARIOUS ˙MOV ˙R5,-(SP) ˙;STACK ˙MOV ˙STKCNT,-(SP) ˙;POSITIONS ˙MOV ˙TEMP,-(SP) ˙MOV ˙SP,TEMP ˙ ˙;REMEMBER STARTING POINT ˙JSR ˙PC,SUBEXP ˙;GET FIRST SUBSCRIPT ˙JSR ˙PC,ARYCOM ˙;DIDDLE SOME BITS ˙BEQ ˙ARY002 ˙;JUMP IF MORE SUBSCRIPTS ˙CMPB ˙R2,#') ˙ ˙;IS THIS THE END?? ˙BEQ ˙ARY005 ˙ ˙;YES ˙TRAP+34. ˙ ˙;TOO MANY SUBSCRIPTS ˙DEC ˙R1 ARY005: ˙MOV ˙#1,R2 ˙ ˙;YES, SPECING AFTER THE LEFT ;PAREN (REPEAT AFTER!) ;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. ; C,EQUT ˙ ˙;COLLECT FIRST ITEM ˙BCS ˙EQUG08 ˙ ˙;SOME ERROR REPORTED AT LOWER LEVEL ˙JSR ˙PC,NXTCH ˙CMPB ˙#',,R2 ˙BNE ˙EQUG06 ˙MOV ˙R0,-(SP) ˙;SAVE BEGIN OF NEXT ITEM EQUG02: ˙JSR ˙PC,EQUT ˙ ˙;SECOND & LATER ITEMS ˙BCS ˙EQUG07 ˙ ˙;"EXIT ON ITEM ERROR ˙MOV ˙@SP,@2(SP) ˙MOV ˙@SP,2(SP) ˙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 = > ) ; ;CLOSE OFF THOT 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 ˙PC,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= ˙TST ˙(SP)+ ˙RTS ˙PC ˙ ˙;NOW RETURN R.R.M. IOG08: ˙JSR ˙R5,OUTCH2 ˙'0 ˙JSR ˙PC,OUTCOM ˙BR ˙IOG12 FY ONE SUBSCRIPT ˙BR ˙ARYEND ˙ ˙;AND CONTINUE ARY002: ˙JSR ˙PC,SUBEXP ˙;DO THE SECOND SUBSCRIPT ˙JSR ˙PC,ARYCOM ˙; DIDDLE SOME BITS ˙BEQ ˙ARY003 ˙ ˙;GO LOOK FOR ANOTHER SUBSCRIPT ˙CMPB ˙R2,#') ˙ ˙;DONE? ˙BEQ ˙ARY006 ˙TRAP+34. ˙DEC ˙R1 ARY006: ˙MOV ˙#2,R2 ˙ ˙;SET TWO SUBSCRIPTS ˙BR ˙ARYEND ˙ ˙;TO GO ARY003: ˙JSR ˙PC,SUBEXP ˙;TRY FOR THIRD ONE ˙JSR ˙PC,ARYCOM ˙CMPB ˙R2,#') ˙ ˙;MUST BE DONE NOW ˙BEQ ˙ARY007 ˙ ˙;OK ˙TRAP+34. ˙DEC ˙R1 ARY007: ˙MOV ˙#3,R2 ˙ ˙;THREE SUBSCRIPTS ARYE; ;ATTEMPT TO COLLECT COMPLEX CONSTANT ; GCMPLX: ˙MOV ˙R1,-(SP) ˙MOVB ˙NOCNSV,-(SP) ˙;SAVE STATE THIS SWITCH ˙INCB ˙NOCNSV ˙ ˙;DON'T SAVE NEXT CONSTANT ˙JSR ˙PC,GET ˙ ˙;LOOK FOR REAL CONSTANT ˙BVS ˙GCMP90 ˙ ˙;PUNT ˙TST ˙R3 ˙BGE ˙GCMP90 ˙ ˙;BR=> NOT A CONSTANT ˙CMP ˙#4,R2 ˙BNE ˙GCMP90 ˙ ˙;BR=> NOT A REAL ; ;HAVE THE BEGINNINGS ; ˙JSR ˙PC,CNXC ˙CMPB ˙#',,(R1)+ ˙ ˙BNE ˙GCMP90 ˙ ˙;NO JOINING COMMA ˙MOVB ˙(SP)+,NOCNSV ˙;USE PE EQUIVALENCE GROUP ; ˙MOV ˙R0,COMNXT ˙;UPDATE FREE STORAGE POINTER ˙ADD ˙#4,SP ˙ ˙;TWO TEMPS ˙MOV ˙(SP)+,R0 ˙;RESTORE BEGINNING OF GROUP ˙CLC ˙RTS ˙PC ; ; ˙ERRORS ; EQUG07: ˙TST ˙(SP)+ EQUG08: ˙TST ˙(SP)+ ˙BR ˙EQUG05 EQUG09: ˙TST ˙˙(SP)+ ˙TRAP+61. ˙ ˙;"MISSING ( OR , " EQUG05: ˙SEC ˙ ˙ ˙;INDICATE ERROR ˙RTS ˙PC EQUG06: ˙TRAP+60. ˙ ˙ ˙;"SYNTAX" ˙BR ˙EQUG07 ; ˙EQUT ; ;COLLECT EQUIVALENCE ITEM AND SAVE AWAY ;INPUT˙.GLOBL ˙IOL,ARY001,LIST11,STKCNT ˙.GLOBL ˙OUTOCT,LSTMOD,COUNT,DONUM,IOL ; ; LISTPR - I/O LIST PROCESSING IS DONE HERE ; LISTPR: ˙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,OUTNAM ˙;OUTPUT TH ND: ˙BIS ˙#101000,R2 ˙;SET SUBSCRIPT REFERENCE IN POLISH ˙MOV ˙R2,-(SP) ˙;PLACE IT IN THE POLISH LIST ˙MOV ˙TEMP,R0 ˙ ˙;REMEMBER WHERE JUNK IS STORED ˙MOV ˙R0,R3 ˙MOV ˙(R0)+,TEMP ˙MOV ˙(R0)+,STKCNT ˙;RESTORE ˙MOV ˙(R0)+,R5 ˙;LOCAL ˙MOV ˙˙(R0)+,R4 ˙;GOODIES ˙MOV ˙(R0)+,-(SP) ˙;PUT SERIAL NUMBER ON POLISH STACK ˙MOV ˙(R0)+,R2 ˙;RESTORE TYPE TOO ˙SWAB ˙R2 ˙ ˙;SHIFT OVER ˙ASL ˙R2 ˙ ˙;AT LEAST ˙ASL ˙R2 ˙ ˙;TWELVE ˙ASL ˙R2 ˙ ˙;FULL ˙ASL ˙R2 ˙ ˙;PLACES ˙CLR ˙-(SP) ˙ ˙;SET TEMPORARY REVIOUS VALUE OF THIS SWITCH ˙MOV ˙CURSYM,R0 ˙;SAVE CURRENT REAL VALUE ˙MOV ˙SYMBYT(R0),-(SP) ˙MOV ˙SYMBYT+2(R0),-(SP) ˙JSR ˙PC,GET ˙ ˙;TRY FOR SECOND REAL ˙BVS ˙GCMP91 ˙ ˙;BR=> PUNT ˙TST ˙R3 ˙BGE ˙GCMP91 ˙ ˙;BR=>NOT CONSTANT ˙CMP ˙#4,R2 ˙BNE ˙GCMP91 ˙ ˙;NOT A REAL ;CLOSING DELIMITER? ˙CMPB ˙#'),(R1)+ ˙BNE ˙GCMP91 ˙ ˙;N.G. ;HAVE COMPLEX - MAKE A VALID ENTRY ˙MOV ˙CURSYM,R4 ˙ADD ˙#4,LENWD(R4) ˙;SAFE TO ASSUME NO BYTE OVERFLOW! ˙MOV ˙SYMBYT(R4),SYMBYT+4(R4) ˙MOV ˙SYMBYT+2(R4) : R0 - WHERE TO STORE ITEM ; ˙ R1 - POINTS TO TEXT ;OUTPUT: R0 - ONE PAST WHERE END OF ITEM ; ˙ R1 - PAST ITEM TEXT ; EQUT: ˙CLR ˙(R0)+ ˙ ˙;CLEAR LINK WORD ˙MOV ˙R0,R2 ˙ ˙;WHERE TO PUT ADB ˙MOV ˙R0,-(SP) ˙ADD ˙#6,R0 ˙CMP ˙R0,COMHGH ˙BHI ˙EQUT08 ˙MOV ˙@SP,R0 ˙JSR ˙PC,LSTITM ˙;COLLECT LIST ITEM ˙BNE ˙EQUT09 ˙ ˙;SOME ERROR ;CHECK THAT ALL OKAY ˙BIT ˙ADJWD(R3),#ADJMKM ˙BNE ˙EQUT09 ˙ ˙;MUST NOT BE ADJUSTABLE ;ALL OKAY ˙MOV ˙(SP)+,R0 ˙;RESTORE POINTER TO SAVE LOC ˙SUB ˙SYMBAS E 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 EVALUATED. ; LIST00: ˙MOV ˙#-1,LSTMOD ˙;CLEAR LAS TERMINATOR ˙JMP ˙SUB010 ˙ ˙;NOW GO PACK POLISH AND CONTINUE ; ARYCOM: ˙MOV ˙(SP)+,@SP ˙;THROW AWAY TERMINATOR ˙BIC ˙#070000,2(SP) ˙;CLEAR OLD MODE CONVERSION ˙BIS ˙#020000,2(SP) ˙;SET INTEGER CONVERSION ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#', ˙;SEE IF IT IS A COMMA ˙RTS ˙PC ˙ ˙;RETURN AND DO SOMETHING ABOUT IT ; ; FUNCTION CALLS ARE HANDLED HERE. ; FUN000: ˙MOV ˙R2,-(SP) ˙;SAVE THE FUNCTION TYPE ˙MOV ˙R4,-(SP) ˙;SA,SYMBYT+6(R4) ˙MOV ˙(SP)+,SYMBYT+2(R4) ˙MOV ˙(SP)+,SYMBYT(R4) ;IF CONSTANTS ARE BEING SAVED - FIX UP SYMNXT ˙TSTB ˙NOCNSV ˙BNE ˙GCMP01 ˙ADD ˙#4,SYMNXT GCMP01: ˙TST ˙(SP)+ ˙ ˙;THROW AWAY SAVED R1 ˙BIC ˙#DATYMM,DATYWD(R4) ˙BIS ˙#24000,DATYWD(R4) ;MAKE DATA TYPE 5 ˙CLC ˙CLV ˙RTS ˙PC ; ;ERROR RETURNES ; GCMP91: ˙TST ˙(SP)+ ˙TST ˙(SP)+ ˙SEC ˙BR ˙GCMP92 GCMP90: ˙MOVB ˙(SP)+,NOCNSV GCMP92: ˙MOV ˙(SP)+,R1 ˙SEV ˙ ˙ ˙;ERROR RETURN ˙RTS ˙PC ,R3 ˙TST ˙R2 ˙ ˙;IS THERE AN ADB ˙BNE ˙EQUT01 ˙ ˙;BR = > YES ˙MOV ˙R3,(R0)+ ˙;NO ADB - ˙CLR ˙(R0)+ ˙CLR ˙(R0)+ ˙BR ˙EQUT02 ;WITH ADB EQUT01: ˙MOV ˙R3,(R0)+ ˙MOV ˙@R0,R2 ˙ ˙;GET #DIMENSION FROM ADB ˙ROL ˙R2 ˙ROL ˙R2 ˙ROL ˙R2 ˙BIC ˙#177774,R2 ˙TST ˙(R0)+ ˙ADD ˙R2,R0 ˙ADD ˙R2,R0 EQUT02: ˙CLC ˙ ˙ ˙;NORMAL EXIT ˙RTS ˙PC ; ;ERRORS: ; EQUT09: ˙TRAP+62. ˙ ˙;"PARAMETER IN EQUIVALENCE STMT" EQUT07: ˙TST ˙(SP)+ ˙SEC ˙CLR ˙R0 ˙RTS ˙PC ; ; EQUT08: ˙TRAP+43. ˙ ˙;"STORAGE OT MODE ˙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 LIST ITEM ˙TST ˙R3 ˙ ˙;IS IT A CONSTANT? ˙BMI ˙LIST2A ˙ VE ˙MOV ˙R5,-(SP) ˙;THE ˙MOV ˙STKCNT,-(SP) ˙;OLD ˙MOV ˙TEMP,-(SP) ˙;GOODIES ˙MOV ˙SP,TEMP ˙ ˙;REMEMBER POSITION ˙MOV ˙SP,R5 ˙ ˙;OF THE NEW GOODIES ˙MOV ˙#102000,-(SP) ˙;SET UP THE ˙MOV ˙R0,-(SP) ˙;FUNCTION NAME ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#'( ˙ ˙;IS THERE A LEFT PAREN ˙BEQ ˙FUN001 ˙ ˙;YES ˙DEC ˙R1 ˙TRAP+35. ˙ ˙;NO ARGUMENTS ˙MOV ˙R5,SP ˙;THROW AWAY NAME ˙MOV ˙(SP)+,TEMP ˙MOV ˙(SP)+,STKCNT ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙MOV ˙(SP)+,R2 ˙RTS ˙PC ˙ ˙;AND RET TAB=11 CR=15 LF=12 ˙.END VERFLOW" ˙BR ˙EQUT07 ;ALLOCATION PHASE FOR COMMON & EQUIVALENCE ; ˙.GLOBL ˙EQVHED,EQVCLS,EQVH1,EQVH2,EQVCOM ˙.GLOBL ˙COMNWD,ALOKAT,ALOCAT OFFSET=2 REL=4 FLT=2 ALOC: ˙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 ˙EQVHE˙;ILLEGAL LIST ITEM ˙BGT ˙ARRAY ˙ ˙;GO PROCESS ARRAY ITEM LIST1B: ˙MOVB ˙(R1)+,R3 ˙CMPB ˙R3,#' ˙BEQ ˙LIST1B ˙CMPB ˙R3,#'= ˙BEQ ˙LIST05 ˙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 ˙JSR ˙PC,NXTCH ˙;GET THE NEXT CHARACTER ˙TST ˙R2 ˙ ˙;EXIT IF ˙BEQ ˙LIST05 ˙ ˙; END OF LINE ˙CMPB ˙R2,#', ˙ ˙;WE MUST HAVE A COMMA IF NOT ˙BNE ˙LIST02 ˙ ˙; ˙JSR URN IN ANGUISH FUN001: ˙MOV ˙R5,-(SP) ˙;SAVE R5 ˙JSR ˙PC,SUBEXP ˙;GO GET A PARAMETER ˙MOV ˙2(R0),R5 ˙ ˙;RESTORE R5 ˙INC ˙-2(R5) ˙ ˙;INCREMENT PARAMETER COUNT ˙TST ˙(SP)+ ˙ ˙;DISCARD ZERO TERMINATOR ˙CMP ˙R0,SP ˙ ˙;IS THERE ONLY ONE ITEM?? ˙BNE ˙FUN004 ˙ ˙;MORE THAN ONE ˙MOV ˙CURSYM,R3 ˙;FIND OUT ˙BIT ˙#PARMKM,PARWD(R3) ;IF IT IS A FORMAL PARAMTER ˙BNE ˙FUN004 ˙ ˙;IF SO, TREAT IT LIKE MORE THAN ONE ˙MOV ˙(SP)+,@SP ˙;NOW REMOVE THE JUNK ˙BPL ˙FUN002 ˙ ˙;IT BETTER BE A VARIABLE OR CONS; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙TBL029 ˙.GLOBL ˙SRCEXT,LSTEXT,OBJEXT ˙.GLOBL ˙LINENO,CURLN,BUFIN,LINE ˙.GLOBL ˙LINKI,LINKSL,LINKOL,MAIN,HDR ˙.GLOBL ˙SRCIN,SRCLS,OBJLS,BUFOUT,BUFOBJ ˙.GLOBL ˙INHD,OUTHD,COMHD,OUTCNT,COMCNT ˙.GLOBL ˙EXEC,BLKDAT,BLKD,TLINE,GBUF ˙.GLOBL ˙D,R0 ˙BEQ ˙EQUE09 ˙ ˙;BR => 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 ˙BCS ˙EQUE02 ˙ ˙;BR=>SUBSCRIPTS OUT OF BOUNDS ˙SUB ˙R5,R4 ˙ ˙;ADJUST FOR ELEMENT SIZE EQUE03: ˙MOV ˙R4,OFFSET(R1) ˙;OFFSET ˙MOV ˙R4,REL(R1) ˙;INITIAL RELATIVE LOCATION ˙RTS ˙PC ; ; EXIT FROM THE ALLOCATION MODULE ; EQUE09: EQUE08: ˙MOVB ˙#1,ALOKAT ˙RTS ˙PC ; EQUE˙PC,NXTCH ˙;GET ANOTHER CHARACTER ˙BR ˙LIST01 ˙ ˙;AND RE-LOOP LIST05: ˙RTS ˙PC LIST02: ˙CMPB ˙R2,#') ˙BNE ˙LIST2A ˙DEC ˙PARCNT ˙BGE ˙LIST10 ˙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 GLOBAL LIST12: ˙JSR ˙PC,OUTNAM ˙;NOW OUTANT ˙TRAP+36. FUN002: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#', ˙;IS IT A SEPARATOR?? ˙BEQ ˙FUN001 ˙ ˙;YES ˙CMPB ˙R2,#') ˙ ˙;IS IT A TERMINATOR?? ˙BEQ ˙FUNFIN ˙ ˙;YES ˙TSTB ˙R2 ˙ ˙;IS IT THE END OF LINE?? ˙BNE ˙FUN003 ˙ ˙;NO ˙TRAP+37. ˙ ˙ ˙;NO CLOSING PAREN FUN003: ˙DEC ˙R1 ˙ ˙;BACK UP OVER TERMINATOR ˙BR ˙FUNFIN ˙ ˙;NOW FINISH UP FUN004: ˙MOV ˙#104000,-(SP) ˙;STORE "$SVSP" ˙SWAB ˙R2 ˙ ˙;GET ˙ASR ˙R2 ˙ ˙;THE ˙ASR ˙R2 ˙ ˙;MODE IN ˙ASR ˙R2 ˙ ˙;BITS 0-2 ˙ASR ˙R2 ˙ ˙;AND CODE,CODECT,DIAG,DIAGCT,DBUF,LGTH,SIZE ˙.GLOBL ˙IMPTAB,PAUSSP,STKCNT,FLAGS,TYPSIZ ˙.GLOBL ˙FLABL,MODNAM,SEQNO,ARYASG,ROUTIN ˙.GLOBL ˙CMDBUF,LINKK,LSTBLK,OBJBLK,INPBLK ˙.GLOBL ˙FNSTK,TEMP,RPC,DPC,RLAB,DLAB ˙.GLOBL ˙DOLST,DOEND,DOTMP,PARCNT ˙.GLOBL ˙HEAD,HEAD1,HLGT,HLGT1,NAMSER ˙.GLOBL ˙STCLR,ENDCLR,ECNT,SRCERR ˙.CSECT ; ; FORTRAN HEADER ; HEAD: ˙.ASCII ˙/; ˙/ HEAD1: ˙.ASCII ˙/FORTRAN / ˙.ASCII ˙/V001A/ ˙.BYTE ˙15,12 HLGT ˙= ˙.-HEAD HLGT1 ˙= ˙.-HEAD1 ˙.EVEN ; ; LENGTH OF MAST02: ˙TRAP+97. ˙;"SUBSCRIPTS OUT OF BOUNDS" ˙JSR ˙R5,OUTCH2 ˙'; ˙MOV ˙@R1,R0 ˙JSR ˙PC,OUTSTR ˙CLR ˙R4 ˙BR ˙EQUE03 ;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 ˙EQUE09 ˙ ˙;BR => NO - GO EXIT ˙CLRTPUT 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 ˙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 ˙#'A,R0 ˙ ˙;THE ADB ADDRESS ˙BR ˙LIST3A ˙ ˙;NOW GO BACK TO MAIN PROCESSIN ˙BIC ˙#177770,R2 ˙;SAVE IT ˙BIS ˙R2,@SP ˙ ˙;IN THE $SVSP CODE ˙MOV ˙FLABL,-(SP) ˙;AND ITS LABEL ˙TST ˙(R0)+ ˙ ˙;UPDATE LIST START POINT ˙MOV ˙R0,R2 ˙ ˙;DELETE ˙MOV ˙R2,R4 ˙ ˙;HTE ˙TST ˙(R4)+ ˙ ˙;SAVED FUN005: ˙MOV ˙-(R2),-(R4) ˙;TEMPORARY ˙CMP ˙R2,SP ˙ ˙;FROM ˙BHI ˙FUN005 ˙ ˙;THE STACK ˙MOV ˙R4,SP ˙ ˙;RESET THE STACK POINTER ˙SUB ˙R4,R0 ˙ ˙;GET COUNT-2 TO TRANSFER ˙MOV ˙R4,R3 ˙ ˙;GENERATE ˙SUB ˙R0,R3 ˙ ˙;THE DESTINATION ADDRESS ˙MOV ˙R3,R2 ˙ ˙;REMEMBER THE ˙ADD ˙R0,R2 ˙ ˙;ADDER WORK BUFFER ; LGTH ˙= ˙432. ˙;THIS DETERMINES NUMBER OF CONTINUATIONS ; SIZE: ˙0 ˙ ˙;MACHINE TOTAL CORE SIZE ; ; COMMAND INPUT LINK BLOCK AND OTHER JUNK ; ˙0 ˙ ˙;ERROR RETURN LINKK: ˙0 ˙ ˙;DDB LINK ˙.RAD50 ˙/FCM/ ˙;"FCM" PACKED RADIX 50 ˙1 ˙.RAD50 ˙/KB/ ˙;"KB" IS DEVICE LSTBLK: ˙CMDBUF ˙LINKSL ˙SRCLS OBJBLK: ˙CMDBUF ˙LINKOL ˙OBJLS INPBLK: ˙CMDBUF ˙LINKI ˙SRCIN ; COMMAND OUTPUT LINK BLOCK ˙.GLOBL ˙LINKL ˙0 LINKL: ˙0 ˙.RAD50 ˙/FCO/ ˙1 ˙.RAD50 ˙/KB/ ; ; SOURCE  ˙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 ˙#EQUE20,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 G ARYELE: ˙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 ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R1 ˙RTS ˙PC LIST04: ˙MOV ˙R1,-(SP) ˙;SAVE THE TEXT POINTER ˙CLR ˙-(SP) ˙ ˙;CLEAR PAREN COUNT LIST06: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#'( ˙ ˙;IS IT A LEFT PAREN? ˙BNE ˙LIST07 ˙ ˙;NO ˙INC ˙@SP ˙ ˙;INCREMENT !RESS OF THE POLISH TO BE MOVED ˙TST ˙-(R3) ˙ ˙;FUDGE THE DESTINATION ADDRESS ˙MOV ˙R3,SP ˙ ˙;RESET THE STACK TO MAKE ROOM FUN006: ˙MOV ˙(R4)+,(R3)+ ˙;FILL OUT THE STACK TO MAKE ˙CMP ˙R4,R5 ˙ ˙; ROOM FOR THE ˙BLO ˙FUN006 ˙ ˙; POLISH TO BE MOVED ˙MOV ˙R2,R3 ˙ ˙;NOW PLACE FUN008: ˙MOV ˙-(R2),-(R4) ˙; THE POLISH ˙CMP ˙R2,SP ˙ ˙; IN THE MIDDLE ˙BHI ˙FUN008 ˙MOV ˙R3,SP ˙ ˙;NOW CLOSE UP THE STACK TO SAVE SPACE ˙MOV ˙FLABL,-(SP) ˙ ˙;SAVE LABEL ON PARAMETER LIST ˙INC ˙FLABL ˙ ˙;ADVANCE THE LA"INPUT LINK BLOCK ; ˙0 ˙ ˙;ERROR RETURN ADDRESS LINKI: ˙0 ˙ ˙;DDB LINK ˙23366 ˙ ˙; "FIN" PACKED MOD 40 ˙1 ˙ ˙;DEVICE SPECIFIED ˙14760 ˙ ˙; IS "DF" ; ; SOURCE LIST LINK BLOCK ; ˙0 ˙ ˙;ERROR RETURN ADDRESS LINKSL: ˙0 ˙ ˙;DDB LINK ˙24204 ˙ ˙; "FSL" PACKED MOD 40 ˙1 ˙ ˙;DEVICE SPECIFIED ˙14760 ˙ ˙; IS "DF" ; ; OBJECT OUTPUT LINK BLOCK ; ˙0 ˙ ˙;ERROR RETURN ADDRESS LINKOL: ˙0 ˙ ˙;DDB LINK ˙23744 ˙ ˙; "FOL" PACKED MOD 40 ˙1 ˙ ˙;DEVICE SPECIFIED ˙14760 ˙ ˙;IS "DF" ; ; SOURCE IN# YET? ˙BLE ˙EQUE21 ˙ ˙;BR = > NO ˙MOV ˙R2,EQVH2 ˙;YES EQUE21: ˙MOV ˙@R1,R4 ˙ ˙;WILL COMPUTE SIZE ˙JSR ˙PC,SIZESN ˙;VALUE IN R4 (IGNORE R5) ˙SUB ˙REL(R1),R4 ˙ADD ˙FLT(R0),R4 ˙;COMPUTE THE HIGHEST EXTENT ˙CMP ˙R4,EQVH1 ˙;HIGHEST YET? ˙BLE ˙EQUE30 ˙ ˙;BR = > 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 POI$PAREN COUNT ˙BR ˙LIST06 LIST07: ˙CMPB ˙R2,#', ˙ ˙;IS IT A COMMA? ˙BEQ ˙LIST08 ˙ ˙;YES ˙TST ˙R2 ˙;EXIT ˙BEQ ˙LIST05 ˙ ˙;IF END OF LINE ˙CMPB ˙R2,#') ˙BNE ˙LIST06 ˙DEC ˙@SP ˙BPL ˙LIST06 ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R1 ˙INC ˙PARCNT ˙JMP ˙LIST1A LIST6A: ˙TST ˙(SP)+ ˙ ˙;POP THE JUNK ˙BR ˙LIST06 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 ˙LIST6%BEL POINTER ˙BIS ˙#170000,@SP ˙;SET LABEL PRESENT FLAG ˙MOV ˙R4,R5 ˙BR ˙FUN002 ˙ ˙;GO GET NEXT ARGUMENT FUNFIN: ˙MOV ˙TEMP,R3 ˙ ˙;RESTORE ˙MOV ˙R3,R2 ˙MOV ˙(R3)+,TEMP ˙;ALL ˙MOV ˙(R3)+,STKCNT ˙;THE ˙MOV ˙(R3)+,R5 ˙;GOODIES ˙MOV ˙(R3)+,R4 ˙;NOW ˙CLR ˙-(SP) ˙ ˙;SET A TERMINATOR ˙MOV ˙(R3)+,R0 ˙;GET THE FUNCTION TYPE ˙MOV ˙(R3)+,-(SP) ˙;GET THE RETURN ADDRESS FUNF01: ˙MOV ˙-(R2),-(R3) ˙;PACK THE ˙BNE ˙FUNF01 ˙ ˙;TEXT ˙TST ˙(R3)+ ˙ ˙;DISCARD TERMINATOR ˙MOV ˙R0,R2 ˙ ˙;PUT TYPE IN&PUT FILE NAME BLOCK ; SRCERR: ˙0 ˙ ˙;ERROR RETURN ADDRESS ˙4 ˙ ˙;OPEN FOR INPUT SRCIN: ˙23752 ˙ ˙;FILE NAME ˙77736 ˙ ˙;IS SRCEXT: ˙74623 ˙ ˙;FORTRN.SRC ˙0 ˙ ˙;UIC ˙0 ˙ ˙;P ; ; SOURCE LIST FILE NAME BLOCK ; ˙.GLOBL ˙LSTER LSTER: ˙0 ˙ ˙;ERROR RETURN ADDRESS ˙2 ˙ ˙;OPEN FOR OUTPUT SRCLS: ˙23752 ˙ ˙;FILE ˙77736 ˙ ˙;NAME IS LSTEXT: ˙47014 ˙ ˙;FORTRN.LST ˙0 ˙ ˙;UIC ˙0 ˙ ˙;P ; ; OBJECT OUTPUT FILE NAME BLOCK ; ˙.GLOBL ˙OBJER OBJER: ˙0 ˙ ˙;ERROR RETURN ADDRESS ˙2 ˙ ˙;OPEN FOR O'NT 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 FURTHER ˙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 (A ˙ ˙; 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 ˙LIST6A ˙ ˙;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 THE INITIALIZATION ˙BVS ˙BADLST ˙CLR ˙IOL ˙MOV ˙R1,@SP ˙ ˙;REMEMBER END OF DOSPEC ˙MOV ˙2(SP),R1 ˙MOV ˙(SP)+,@SP ˙MOV ) R2 ˙MOV ˙(SP)+,R0 ˙;GET RETURN ADDRESS ˙MOV ˙R3,SP ˙ ˙;RESET THE STACK ˙MOV ˙#100400,-(SP) ˙;SET END OF FUNCTION ˙CLR ˙-(SP) ˙ ˙;SET ZERO TERMINATOR ˙JMP ˙@R0 ˙ ˙;RETURN TO CALLER ; ; THIS PORTION OF SUBEXP DOES THE ACTUAL CODE GENERATION FOR ; ˙THE EXPRESSION PREVIOUSLY GENERATED IN POLISH ; ; ˙UPON ENTRY, R0 POINTS TO THE START OF THE POLISH ; ˙STRING WHICH IS TERMINATED BY A ZERO WORD ; ; ˙NOTE THAT IT IS UP TO THE CALL*UTPUT OBJLS: ˙23752 ˙ ˙;FILE NAME ˙77736 ˙ ˙;IS OBJEXT: ˙57032 ˙ ˙;FORTRN.OBJ ˙0 ˙ ˙;UIC ˙0 ˙ ˙;P ; ; OUTPUT WORKING BUFFER ; BUFOBJ: ˙.BYTE ˙'; ˙ ˙;HEADER BYTE BUFOUT: ˙ ˙ ˙ ˙;MAIN BUFFER . ˙= ˙.+120 ˙ ˙;80 CHAR LONG BUFFER ; ; DIAGNOSTIC AND CODE BUFFER ; DCHAR: ˙.BYTE ˙'; DBUF: . ˙= ˙.+120 ˙ ˙;80 CHARS LONG ˙.EVEN CMDBUF: ˙0,0,0,0,0,0,0 ˙;COMMAND INTERPRETER HEADER ; ; INPUT BUFFER ; INHD: ˙80. ˙ ˙ ˙;CONTAINS NO MORE THAN 80 BYTES ˙0 ˙ ˙ ˙;FORMATTED ASCII INPUT ˙0 ˙ ˙ ˙;B+˙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 ˙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 ;,˙LSTMOD,-(SP) ˙;SAVE LAST MODE ˙MOV ˙COUNT,-(SP) ˙;AND COUNT ˙JSR ˙PC,LIST00 ˙;GO GET THE I/O LIST ˙MOV ˙R3,-(SP) ˙MOV ˙#-1,R2 ˙ ˙;FINISH UP THE JUNK ˙JSR ˙PC,TSTM01 ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,COUNT ˙;RESTORE ˙MOV ˙(SP)+,LSTMOD ˙;COUNT AND MODE ˙MOV ˙R3,-(SP) ˙MOV ˙LINENO,-(SP) ˙;SAVE REAL LINE NUMBER ˙MOVB ˙DONUM,LINENO ˙DEC ˙DONUM ˙CLRB ˙LINENO+1 ˙JSR ˙PC,DODON ˙;GO HANDLE DO ENDING ˙MOV ˙(SP)+,LINENO ˙;RESTORE REAL LINE NUMBER ˙CMPB ˙(SP)+,#'= ˙;MAKE SURE IT IS CORRECT -ING ROUTINE TO ; ˙PURGE THE STACK UPON RETURNING ; ; SUB22A: ˙TST ˙-2(R5) ˙BPL ˙SUB22D ˙BIT ˙#004000,-2(R5) ˙;DOES A STACK SAVE FOLLOW THE PUSH ˙BEQ ˙SUB22D ˙ ˙;NO ˙MOV ˙CURSYM,R3 ˙;IS IT A PARAMETER?? ˙BIT ˙#PARMKM,PARWD(R3) ;IF IT IS NOT ˙BEQ ˙SUB22D ˙ ˙;DO A NORMAL PUSH ˙MOV ˙#SVP,R4 ˙ ˙;SET UP FOR ˙JSR ˙PC,PUTNAM ˙; PARAMETER PUSH ˙BITB ˙BITM+5,MISC+1 ˙;DOES IT NEED A GLOBAL?? ˙BNE ˙SUB042 ˙ ˙;NO ˙BISB ˙BITM+5,MISC+1 ˙;SET DONE BIT ˙JSR ˙PC,OUTGL ˙;OUTPUT THE GLOBAL ˙JSR .YTE COUNT TRANSFERRED BUFIN: ˙ ˙ ˙ ˙;INPUT BUFFER PROPER . ˙= ˙.+120 ˙ ˙;80 CHARS LONG ; ; OUTPUT BUFFER HEADERS ; OUTHD: ˙100. ˙ ˙ ˙;100 BYTES LONG ˙4 ˙ ˙ ˙;DUMP ASCII MODE OUTCNT: ˙0 ˙ ˙ ˙;COUNT FOR OUTPUT ˙BUFOUT ˙ ˙ ˙;POINTS TO BUFFER ; SAME AS ABOVE WITH ";" PRECEDING LINE COMHD: ˙101. ˙ ˙ ˙;ONE BYTE LONGER ˙4 ˙ ˙ ˙;DUMP ASCII MODE COMCNT: ˙0 ˙ ˙ ˙;BYTE COUNT ˙BUFOBJ ; ; CODE GENERATION BUFFER HEADER ; CODE: ˙80. ˙ ˙ ˙;80 BYTES LONG ˙4 ˙ ˙ ˙;DUMP ASCII MODE CODECT: ˙0 ˙ ˙ ˙;O/ 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: ˙TRAP+63. ˙ ˙;"INCONSISTANT EQUIVALENCE" ˙JSR ˙R5,OUTCH2 ˙'; ˙MOV ˙@R1,R0 ˙JSR ˙PC,OUTSTR ˙;NAME OF VARIABLE ˙J0 ˙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 CURRENT VALUE TSTM01: ˙INC ˙COUNT ˙ ˙;ADVANCE THE1˙PC,EOL ˙ ˙;AND AN END OF LINE SUB042: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙JSR ˙PC,OUTCOM ˙;AND A COMMA ˙MOV ˙@R3,R3 ˙ ˙;GET POSITION OF PARAMETER ˙BIC ˙#PARXMK,R3 ˙;CLEAR JUNK BITS ˙JSR ˙PC,OUTOCT ˙;OUTPUT THE POSITION ˙BR ˙SUB043 ˙;AND FINISH UP EXPGEN: ˙MOV ˙R0,R5 ˙ ˙;PLACE POINTER IN R5 ˙TST ˙(R5)+ ˙ ˙;PRE-FUDGE THE POINTER ˙CLR ˙R2 SUB021: ˙MOV ˙-(R5),R0 ˙;PICK UP THE ENTRY ˙BEQ ˙SUB026 ˙ ˙;QUIT WHEN DONE ˙BMI ˙SUB024 ˙ ˙;GO PROCESS OPERATOR ˙BIC ˙#170000,R0 ˙;CLEAR CONVERSION F2UTPUT COUNT ˙DBUF ˙ ˙ ˙;BUFFER POINTER ; ; OBJECT DIAGNOSTIC BUFFER HEADER ; DIAG: ˙81. ˙ ˙ ˙;81 BYTES LONG ˙4 ˙ ˙ ˙;DUMP ASCII MODE DIAGCT: ˙0 ˙ ˙ ˙;BYTE COUNT ˙DCHAR ˙ ˙ ˙;BUFFER POINTER ; ; GENERAL PURPOSE DUMP ASCII MODE HEADER ; GBUF: ˙80. ˙ ˙ ˙;80 BYTES LONG ˙4 ˙ ˙ ˙;DUMP ASCII MODE ˙0 ˙ ˙ ˙;BYTE COUNT ˙0 ˙ ˙ ˙;BUFFER LINK ; ; MASTER WORKING LINE BUFFER ; ; ˙THIS BUFFER CONTAINS THE LINE AFTER THE LINE NUMBER ; ˙AND ANY CONTINUATIONS HAVE BEEN HANDLED. THE STRING ; ˙IN IT3SR ˙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, IN COMMON EQUE64: ˙RTS ˙PC ˙ ˙;IF NOT - JUST QUIT4 COUNT ˙CMP ˙R2,LSTMOD ˙;ARE THE CURRENT AND LAST MODES EQUAL? ˙BEQ ˙TSTM02 ˙ ˙;YES, DON'T GENERATE ANYTHING ˙MOV ˙LSTMOD,R4 ˙;GET THE PREVIOUS MODE ˙MOV ˙R2,LSTMOD ˙;SAVE THE NEW MODE ˙MOV ˙R4,R2 ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE PUSH PROTOTYPE ˙INIT07 ˙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 ˙B5LAG ˙JSR ˙PC,SERATR ˙;GET ATTRIBUTES OF VARIABLE, ETC. ˙CMP ˙R2,#6 ˙ ˙;IS THIS BYTE MODE?? ˙BNE ˙SUB004 ˙ ˙;NO ˙MOV ˙#2,R2 ˙ ˙;SET IT TO INTEGER SUB004: ˙CMP ˙R3,#1 ˙ ˙;ARRAY? ˙BNE ˙SUB22A ˙ ˙;NO ˙TST ˙-2(R5) ˙ ˙;IS THE NEXT OPERATION AN OPERATOR???? ˙BPL ˙SUB22B ˙ ˙;NO ˙BIT ˙#004000,-2(R5) ˙;IS IT A STACK SAVE? ˙BEQ ˙SUB22B ˙ ˙;NO ˙MOV ˙#SVA,R4 ˙;IF IT IS, PUSH THE ARRAY ADDRESS ˙JSR ˙PC,PUTNAM ˙BITB ˙BITM+3,MISC+0 ˙;DOES IT NEED A GLOBAL? ˙BNE ˙SUB22C ˙ ˙;NO ˙BISB ˙BITM+3,MI6 IS ALWAYS TERMINATED BY A ZERO BYTE. ; ˙THE LENGTH SHOULD BE 72 X 6 BYTES LONG(432). ; LINE: . ˙= ˙.+LGTH ; ; MAIN PROGRAM HEADER NAME ; MAIN: ˙.ASCII ˙/MAIN./ ˙.BYTE ˙0 ; ; BLOCK DATA HEADER NAME ; BLKD: ˙.ASCII ˙/DATA./ ˙.BYTE ˙0 ˙.EVEN ; ; START OF AREA TO BE CLEARED ; STCLR: ; ; DIAGNOSTIC TABLE ; ;WORD 1 - CONTENTS OF R1 AT TIME OF ERROR ;WORD 2 - ERROR NUMBER ; ONLY TEN ENTRIES ARE ALLOWED HERE ; ERRCUR: ˙0 ˙ ˙;POINTER TO CURRENT DIAG. ENTRY ERRS: ˙0,0 ˙ ˙;FIRST ENTRY7. 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 ˙TRAP+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 8ISB ˙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: ˙RTS ˙PC ˙.GLOBL ˙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: ˙MOV ˙C9SC+0 ˙;SET DONE BIT ˙JSR ˙PC,OUTGL ˙;OUTPUT THE GLOBAL ˙JSR ˙PC,EOL ˙ ˙;AND AN END OF LINE SUB22C: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙JSR ˙PC,OUTCOM ˙MOV ˙R0,R3 ˙MOV ˙#'A,R0 ˙JSR ˙PC,OUTSER ˙;FOLLOWED BY THE ARRAY SERIAL SUB043: ˙JSR ˙PC,OUTCOM ˙;OUTPUT ANOTHER COMMA ˙TST ˙-(R5) ˙ ˙;SKIP THE $SVSP ˙MOV ˙-(R5),R3 ˙;GET THE LABEL ˙MOV ˙#'F,R0 ˙ ˙;AND OUTPUT ˙JSR ˙PC,OUTSER ˙;THE LABEL ˙JSR ˙PC,EOL ˙BR ˙SUB021 ˙ ˙;NOW RE-LOOP SUB22B: ˙TRAP+32. ˙ ˙;NO SUBSCRIPT ON ARRAY REFERENCE S:, DIAG. TABLE .=.+22 ERREND=. .GLOBL ˙ERRCUR,ERRS,ERREND ; ; COMPILATION ERROR COUNT ECNT: ˙0 ; ; MODULE NAME IN RADIX50 ; MODNAM: ˙0,0 ; ; BLOCK DATA FLAG SET IF BLOCK DATA ROUTINE ; BLKDAT: ˙0 ; ; BUFFER FULL FLAG, SET WHEN NON-CONTINUATION LINE ; ˙IS FOUND IMMEDIATELY AFTER CONTINUATION LINE ; CURLN: ˙0 ; ; EXECUTABLE STATEMENT FOUND FLAG ; EXEC: ˙0 ; ; HEADER GENERATED FLAG - SET WHEN PROGRAM, SUBROUTINE ; ˙OR FUNCTION HEADER IS GENERATED FOR FIRST TIME ; HDR: ˙0 ; ; LINE; ˙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 ˙EQUE80 ˙ ˙;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 ; ; ; EQUE69: ˙MOV ˙@R1,R2 ˙ADD ˙SYMBAS,R2 ˙BIS ˙#COMMKM,COMWD(R2) ˙<URSYM,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 ˙#'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 ˙=UB22D: ˙JSR ˙PC,OUTTAB ˙MOV ˙R0,R3 ˙MOV ˙#'P,R0 ˙JSR ˙PC,OUTSER ˙;OUTPUT THE LABEL SUB016: ˙JSR ˙PC,EOL ˙ ˙;NOW AN END-OF-LINE ˙TST ˙R2 ˙ ˙;CHECK FOR BYTE MODE ˙BNE ˙SUB022 ˙ ˙;IS OK ˙TRAP+22 ˙ ˙ ˙;LOGICAL*1 NOT ALLOWED IN EXPRESSION SUB022: ˙MOV ˙@R5,R3 ˙ ˙;GET CONVERSION MODE ˙BIC ˙#107777,R3 ˙;CLEAR SERIAL NUMBER ˙BEQ ˙SUB021 ˙ ˙;JUMP IF NO CONVERSION ˙SWAB ˙R3 ˙ ˙;GET ˙ASR ˙R3 ˙ ˙; THE ˙ASR ˙R3 ˙ ˙; MODE ˙ASR ˙R3 ˙ ˙; INTO ˙ASR ˙R3 ˙ ˙; LOW-ORDER ˙CMPB ˙CHR(R2),CHR(> NUMBER IN ASCII. IF FIRST BYTE IS ZERO, ; ˙NO LINE NUMBER EXISTS ; LINENO: ˙0,0,0 ˙ ˙;PERMANENT LINE NUMBER TLINE: ˙0,0,0 ˙ ˙;TEMPORARY LINE NUMBER - ONLY FORTION USES IT PAUSSP: ˙0 ˙ ˙ ˙;PAUSE AND STOP TEMPORARY ; EXPRESSION EVALUATOR ROUTINES ; STKCNT: ˙0 FLAGS: ˙0 FLABL: ˙0 ˙ ˙;INTERNAL LABEL CELL SEQNO: ˙0 ˙ ˙;STATEMENT SEQUENCE NUMBER ARYASG: ˙0 ˙ ˙;ARRAY ASSIGNMENT FLAG ROUTIN: ˙0 ˙ ˙;=0 FOR MAIN PROGRAM ˙ ˙ ˙;=1 FOR SUBROUTINE ˙ ˙ ˙;=2 FOR FUNCTION NAMSER: ˙0 ˙ ˙;0 IF MAIN ˙ ˙?;SET THE COMMON BIT ˙MOVB ˙R4,COMNWD(R2) ˙ ˙;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 ˙MOV ˙R0,EQVH3 ˙;SAVE FOR L@PARXWD(R0),R3 ˙;GET THE PARAMETER INDEX ˙BIC ˙#177400,R3 ˙JSR ˙PC,OUTOCT ˙BR ˙PVAR03 PVAR01: ˙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 ˙; A COMMA ˙JSR ˙PC,OUTST ˙;AND THE SYMBOL NAME PVAR03: ˙JSR ˙PC,EOL ˙ ˙;FINALLY AN END OF LINE ˙RTS ˙PC ; MODE: ˙.BYTE ˙'B,'L,'I,'R,'D,'C,'X,'A ˙.EVEN AR3) ˙;SAME MODE???? ˙BEQ ˙SUB021 ˙ ˙;YES, DO NOTHING ˙MOVB ˙#TAB,R4 ˙JSR ˙PC,PUTCHR ˙MOVB ˙#'$,R4 ˙JSR ˙PC,PUTCHR ˙MOVB ˙CHR(R2),R4 ˙;STORE ˙JSR ˙PC,PUTCHR ˙;THE ˙MOVB ˙CHR(R3),R4 ˙;MODE ˙JSR ˙PC,PUTCHR ˙;CONVERSION ˙BITB ˙BITM(R2),CV1(R3) ;GENERATE GLOBAL? ˙BNE ˙SUB025 ˙ ˙;NO ˙BISB ˙BITM(R2),CV1(R3) ;YES, SET GENERATED ˙JSR ˙PC,OUTGL ˙JSR ˙PC,EOL SUB025: ˙JSR ˙PC,OUTNAM ˙JSR ˙PC,EOL ˙ ˙;DO AN END-OF-LINE PWR4: ˙MOV ˙R3,R2 ˙ ˙;SET CURRENT MODE PWR3: ˙BR ˙SUB021 ˙;AND RE-LOB ˙;NONZERO MEANS SERIAL NUMBER OF NAME ; ; FAKE SYMBOL TABLE ENTRY FOR FUNCTION NAME ; SYMSER: ˙0,0,0,0,0,0,0 ˙.GLOBL ˙SYMSER PARCNT: ˙0 FNSTK: ˙0 ˙ ˙;STACK DEPTH DURING A FUNCTION CALL TEMP: ˙0 ˙ ˙;TEMPORARY CELL USED DURING EXPRESSION EVALUATION ; ; TEMPORARIES USED IN END PROCESSING ; RPC: ˙0 DPC: ˙0 RLAB: ˙0 DLAB: ˙0 ; ; I/O TEMPORARIES ; ˙.GLOBL ˙LSTMOD,COUNT,DONUM,IOL,INHLAB LSTMOD: ˙0 COUNT: ˙0 DONUM: ˙0 IOL: ˙0 INHLAB: ˙0 ˙ ˙ ˙;INHIBIT LABEL GENERATION FOR IF ; ; DO TACATER USE ˙MOV ˙#EQUE72,R3 ˙;THE ROUTINE TO CALL ˙MOV ˙EQVCLS,R0 ˙;NEXT LOOP PUTTING 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 ˙ADD ˙EQVDEL,R3 ˙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 DOPTLST: ˙OPT1 ˙OPT2 ˙OPTEND ˙0 OPT1: ˙.ASCII ˙/END=/ OPT2: ˙.ASCII ˙/ERR=/ OPTEND ˙= ˙. ˙.EVEN FMPSH: ˙.ASCII ˙/ ˙$PSH/ ˙.BYTE ˙0 RPSH: ˙.ASCII ˙/ ˙$PSHR1/ ˙.BYTE ˙15,12,0 FMTLAB: ˙.BYTE ˙'0 FMTLB1: ˙.BYTE ˙15,12,0 ˙.EVEN IOG02: ˙P1,P2,P3,P4,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 EOP CHR: ˙.BYTE ˙'B,'I,'I,'R,'D,'C ˙.EVEN SUB026: ˙RTS ˙PC ; ; THIS SECTION HANDLES OPERATORS, ARRAYS, FUNCTIONS, ETC. ; ; SUB024: ˙BIT ˙#004000,R0 ˙;IS THIS A STACK POINTER SAVE?? ˙BNE ˙SVSP00 ˙ ˙;YES ˙BIT ˙#002000,R0 ˙;IS IT A FUNCTION CALL?? ˙BNE ˙FUNC98 ˙ ˙;YES ˙BIT ˙#001000,R0 ˙;IS IT AN ARRAY REFERENCE? ˙BNE ˙REF001 ˙ ˙;YES ; ˙WE NOW HAVE A NORMAL OPERATORIN R0, BUT ; ˙SPECIAL THINGS MUST HAPPEN TO IT IF ; ˙IT IS AFBLE - CONTAINS ACTIVE DO ENTRIES ; ˙ONLY ACTIVE ENTRIES ARE CONTAINED IN THIS TABLE, ; ˙INACTIVE ENTRIES MUST BE REMOVED ; DOLST: . ˙= ˙.+214 ˙ ˙;ROOM FOR TEN ENTRIES DOEND ˙= ˙. DOTMP: ˙0,0,0,0,0,0,0 ˙;DO STATEMENT TEMPORARY ; ; ˙SYMBOL TABLE POINTERS, ETC. ; .GLOBL ˙ADBCUR,CCCC,CURSYM,DDDD,GETSW .GLOBL ˙IIII,LSTCHN,MMMM,MOD40,NOCNSV,RRRR .GLOBL ˙SERIAL,SYMBAS,SYMCUR,SYMEND,SYMNXT ; SYMBAS: ˙0 ˙;START OF SYMBOL TABLE LSTCHN: ˙0 ˙;ADDRESS OF LAST ENTRY REFERENCED IN TABLE SYMEND: ˙0 ˙;ADDGCLASS. ; ;A SYMBOL RELATIVE TO A SYMBOL IN COMMON ; EQUE72: ˙MOV ˙@R1,R4 ˙ ˙;GET STEX ˙CMP ˙R4,EQVCOM ˙;BASE 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),HP6: ˙.ASCII ˙/ ˙$OUTI/ ˙.BYTE ˙0 P7: ˙.ASCII ˙/ ˙$OUTFI/ ˙.BYTE ˙0 INIT05: ˙.ASCII ˙/0,0/ ˙.BYTE ˙15,12,0 INIT07: ˙.ASCII ˙/ ˙$PSH,/ ˙.BYTE ˙0 INIT08: ˙.ASCII ˙/ ˙$IO/ ˙.BYTE ˙0 FIN00: ˙.ASCII ˙/ ˙$IOF/ ˙.BYTE ˙15,12,0 ˙.EVEN ˙.END ; ˙ 0 IF READ INY OF THE LOGICALS, NAMELY ; ˙EQ, NE, GT, LT, GE, OR LE. ; ˙CLR ˙-(SP) ˙ ˙;CLEAR LOGICAL SWITCH ˙CMPB ˙R0,LT+1 ˙ ˙;IS THE OPERATOR A LOGICAL? ˙BLT ˙SUB42 ˙ ˙;NO ˙CMPB ˙R0,GE+1 ˙ ˙;TRY AGAIN ˙BLE ˙SUB43 ˙ ˙;YEA TEAM, WE GOT ONE SUB42: ˙MOV ˙#TAB,R4 ˙JSR ˙PC,PUTCHR ˙MOVB ˙#'$,R4 ˙JSR ˙PC,PUTCHR ˙BIC ˙#177700,R0 ˙;GET OPERATOR ˙DEC ˙R0 ˙ ˙;CONVERT INTO ˙ASL ˙R0 ˙ ˙;INDEX ˙MOVB ˙OPTAB(R0),R4 ˙;AND ˙JSR ˙PC,PUTCHR ˙;STORE ˙MOVB ˙OPTAB+1(R0),R4 ˙;THE ˙JSR ˙PC,PUTCHR ˙;OPERATOR JRESS OF LAST WORD OF FREE SPACE SYMNXT:;ALTERNATE NAME FOR SYMCUR SYMCUR: ˙0 ˙;START OF FREE SPACE MOD40: ˙0,0 ˙;MOD 40 WORK AREA CURSYM: ˙0 ˙;ADDRESS OF CURRENT ENTRY SERIAL: ˙0 ˙;CURRENT SERIAL #(INC BY 1 FOR NEXT ENTRY) ADBCUR: ˙0 ˙;ADB ADDRESS MOST RECENTLY ENTERED INTABLE GETSW: ˙.BYTE ˙0 ˙;GET CONTROL SWITCH NOCNSV: ˙.BYTE ˙0 ˙;CONSTANT SUPPRESSION SWITCH ˙.EVEN IIII: ˙0 RRRR: ˙0 DDDD: ˙0 CCCC: ˙0 MMMM: ˙0 ; ;CELLS FOR FORCOM, FORDAT, FORASF ; ˙.GLOBL ˙EQVH3,EQVDEL,FNCTYP EQVH3:KR3 ˙SUB ˙EQVDEL,R3 ˙MOV ˙R3,-(SP) ˙;SAVE FOR LATER MAGNITUDE CHECK ˙JSR ˙PC,OUTOCT ˙;THE DISPLACEMENT ˙JSR ˙PC,EOL ˙MOV ˙(SP)+,R3 ˙;RECOVER OFFSET ˙NEG ˙R3 ˙CMP ˙R3,EQVH3 ˙;COMPARE TO AVAILABLE ROOM ˙BLE ˙EQUE75 ˙ ˙;BR=>ENUF ROOM ˙TRAP+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 EQUE80: ˙JSR ˙R5,OUTLN2 ˙M ˙CMP ˙R0,#OPT ˙ ˙;IS THIS EXPONENTIATION ˙BNE ˙PWR1 ˙;NO ˙TST ˙(SP)+ ˙ ˙;DISCARD LOGICAL SWITCH ˙MOV ˙-(R5),R3 ˙;GET BASE MODE ˙SWAB ˙R3 ˙ ˙;AND PUT ˙ASR ˙R3 ˙ ˙;THE THREE BITS ˙ASR ˙R3 ˙ ˙;INTO THE ˙ASR ˙R3 ˙ ˙;PROPER ˙ASR ˙R3 ˙ ˙;PERSPECTIVE ˙BIC ˙#177770,R3 ˙;FOR USE ˙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),EN ˙0 EQVDEL: ˙0 ;FAKSYM OCCUPIES THE SAME SPACE AS DOLST ˙.GLOBL ˙FAKSYM,DATTYP,DATVST FAKSYM=DOLST DATTYP=DOLST+32 DATVST=DOLST+34 ;ASF FUNCTION TYPE FNCTYP: ˙0 .GLOBL ˙GL1,GL2,CV1,MISC,BITM,PUTWK,PUTA ; ; BYTE TABLE OF GLOBALS ; ; BIT POSITIONS ARE ASSIGNED AS FOLLOWS: ; ˙BIT ˙MODE ; ˙ 0 ˙0 - B ; ˙ 1 ˙1 - I ; ˙ 2 ˙2 - I ; ˙ 3 ˙3 - R ; ˙ 4 ˙4 - D ; ˙ 5 ˙5 - C ; ˙ 6 ˙ 6 ; ˙ 7 ˙ 7 ; ; ; GL1: ˙.BYTE ˙0 ˙;POP ˙.BYTO;$TR ˙EQUE84 ˙MOV ˙#'F,R0 ˙MOV ˙FLABL,R3 ˙JSR ˙PC,OUTSER ˙JSR ˙PC,EOL ˙MOV ˙EQVCLS,R0 ˙;EQUIVALENCE CLASS ˙MOV ˙#EQUE81,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 ˙JSR ˙PC,OUTOCT ˙JSR ˙PC,EOL ˙ ˙;THIS ENDS THIS CLASS. ˙MOV ˙#'F,R0 ˙ ˙;CLOSING LABEL ˙MOV ˙FLABL,R3 ˙JSR ˙PC,OUTSER ˙INC ˙FLABL ˙JSR ˙R5,OUTLN2 ˙EQUE85 ˙JMP ˙EQUE10 ˙ ˙;BACK TO BEGINNING ; ; FOR EACP; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙OVLAY ; ; OVERLAY CONTROLLER FOR THE FORTRAN COMPILER ; ; ˙EACH OF THE VARIOUS OVERLAY ROUTINES HAS AN ENTRY ; ˙POINT IN THIS ROUTINE. ; ; ˙THE ENTRY INDEX IS A VALUE WHICH, WHEN ADDED TO ; ˙THE START ADDRESS OF THE OVERLAY, POINTS TO A WORDQXPMAP(R3) ;SET 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 ˙2(R5),@R5 ˙;FUDGE THE ENTRY ˙JMP ˙SUB022 ˙ ˙;AND TRY FOR MODE CHANGE PWR1: ˙TST ˙(SP)+ ˙ ˙;IS THIS LOGICAL OPERATION? ˙BEQ ˙PWR1A ˙ ˙;NO ˙MOV ˙#1,R2 ˙ ˙;SET THE MODE TO LOGICAL ˙BR ˙PWR1B PWR1A: ˙MOVB ˙CHR(R2),R4 ˙;NOW THE ˙JSR ˙PC,PUTCHR ˙;MODE PWRRE ˙0 ˙;SBS ˙.BYTE ˙0 ˙;PUT ˙.BYTE ˙0 ˙;GET ˙.BYTE ˙0 ˙;PSHR ˙.BYTE ˙0 ˙;POPP ˙.BYTE ˙0 ˙;POPR GL2: ˙.BYTE ˙0 ˙;OR ˙.BYTE ˙0 ˙;AND ˙.BYTE ˙0 ˙;NOT ˙.BYTE ˙0 ˙;ADD ˙.BYTE ˙0 ˙;SUBTRACT ˙.BYTE ˙0 ˙;MULTIPLY ˙.BYTE ˙0 ˙;DIVIDE ˙.BYTE ˙0 ˙;EXPONENTIATE ˙.BYTE ˙0 ˙;NEGATE ˙.BYTE ˙0 ˙;.LT. ˙.BYTE ˙0 ˙;.EQ. ˙.BYTE ˙0 ˙;.NE. ˙.BYTE ˙0 ˙;.LE. ˙.BYTE ˙0 ˙;.LE. ˙.BYTE ˙0 ˙;.GE. ˙.BYTE ˙0 ˙;$CM ; ; CONVERSION TABLE ; CV1: ˙.BYTE ˙0 ˙;B ˙.BYTE ˙0 ˙;I ˙.BYTE ˙0 ˙;I ˙.BYSH 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 ˙EQUE86 ˙ ˙;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 ˙JSR ˙PC,OUTOCT ˙;USE IT ˙JSR ˙PC,EOL ˙ ˙;END THE LINE EQUE86: ˙RTS ˙PC ; EQUE83: ˙.BYTE ˙'. EQUE82: ˙.BYTE ˙TAB,'=,'.,'+,0 EQUE84: ˙.BYTE ˙TAB,'$,'T,'R,',,0 EQUE85: ˙T ; ˙CONTAINING THE ADDRESS OF THE DESIRED ROUTINE ; ˙IN THE OVERLAY. ; ; ˙THE OVERLAY INDEX POINTS TO THE DATA AREA DESCRIBING ; ˙THE DESIRED OVERLAY. THIS AREA CONSISTS OF THE FOLLOWING ; ˙ITEMS: ; ; ˙ ˙WORD 0 - DISK ADDRESS OF OVERLAY ; ˙ ˙WORD 1 - CORE ADDRESS FOR LOADING ; ˙ ˙WORD 2 - LENGTH (IN WORDS) OF THE OVERLAY ; ˙ ˙WORD 3 - 4 ; ˙ ˙WORD 4 - 0 ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; WARNING - THIS ROUTINE IS NOT ALLOWED TO SAVE ; ˙TEMPORARIES ON THE STACK IU1B: ˙ASR ˙R0 ˙ ˙;CONVERT TO BYTE INDEX ˙BITB ˙BITM(R2),GL2(R0) ;WAS A GLOBL GENERATED ˙BNE ˙SUB027 ˙ ˙;YES ˙BISB ˙BITM(R2),GL2(R0) ;SET GENERATED BIT ˙JSR ˙PC,OUTGL ˙;OUTPUT THE GLOBAL ˙JSR ˙PC,EOL SUB027: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙JSR ˙PC,EOL ˙BIC ˙#100000,@R5 ˙;CLEAR THE SIGN BIT ˙JMP ˙SUB022 ˙ ˙;GO GENERATE MODE CHANGE IF ANY SVSP00: ˙BR ˙SVSP FUNC98: ˙BR ˙FUNC99 REF001: ˙BR ˙ARYREF ; ; HANDLE LOGICAL FORMS HERE SUB43: ˙INC ˙@SP ˙ ˙;SET LOGICAL SWITCH ˙MOV ˙#CMP,R4 ˙ ˙VTE ˙0 ˙;R ˙.BYTE ˙0 ˙;D ˙.BYTE ˙0 ˙;C ; ; MISCELLANEOUS MODES ; ; ˙BYTE 0 ; ˙BIT ˙NAME ; ˙ 0 ˙$SVSP ; ˙ 1 ˙$PSH ; ˙ 2 ˙$RET ; ˙ 3 ˙$SVA ; ˙ 4 ˙$TR ; ˙ 5 ˙$TRX ; ˙ 6 ˙$TRAL ; ˙ 7 ˙$TRA ; ; ˙BYTE 1 ; ˙BIT ˙NAME ; ˙ 0 ˙$ASP ; ˙ 1 ˙$AS ; ˙ 2 ˙$PSHP ; ˙ 3 ˙$ENDDO ; ˙ 4 ˙$ENDDP ; ˙ 5 ˙$SVP ; ˙ 6 ˙$SVE ; ; ˙BYTE 2 ; ˙BIT ˙NAME ; ˙ 0 ˙$FIND ; ˙ 1 ˙$INI ; ˙ 2 ˙$INFI ; ˙3 ˙$INRI ; ˙ 4 ˙$OUTI ; ˙ 5 ˙$OUTFI ; ˙ 6 ˙$OUTRI ; ˙ 7 ˙$IOF ; ; ˙BYTE 3 ; ˙BIT ˙NAME ; ˙ 0 ˙$IOB ; ˙ 1W.BYTE ˙TAB,'=,'.,CR,LF,0 ˙.EVEN ;LIST LOOK ;LINK THROUGH LIST GIVEN BY R0 (MAY BE EMPTY) - CALLING GIVEN ROUTINE ;FOR EACH ITEM ; ˙INPUT ˙R0 - ADDRESS OF FIRST GROUP ; ˙ ˙R3 - 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: ˙BXF THEY WOULD REMAIN ; ˙WHILE AN OVERLAY ROUTINE GETS CALLED, SINCE ; ˙SOME OVERLAYS EXPECT ARGUMENTS ON THE STACK ; ˙ ˙ ˙ ---------------------- ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 STATUS ˙= ˙177776 ˙ ˙;STATUS REGISTER ; ˙.CSECT ; ˙.GLOBL ˙LOWLOC,LOW,HIGH,TFUN LOWLOC ˙= ˙. ˙;THIS IS THE LOWEST ADDRESS USED BY ˙ ˙ ˙;THE COMPILER ; OVNUM: ˙.WORD ˙DESCR ˙;OVERLAY NUMBER CURRENY;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 ˙BR ˙SUB42 ˙ ˙;NOW DO REST OF STUFF ; ; HANDLE ADDRESS SUBSTITUTION FOR FUNCTION CALLS ; SVSP: ˙BIC ˙#177770,R0 ˙;GET THE MODE Z ˙$IOL ; ˙ 2 ˙$IOI ; ˙ 3 ˙$IOR ; ˙ 4 ˙$IOD ; ˙ 5 ˙$IOC ; ˙ 6 ˙NONE ; ˙ 7 ˙$IOA ; ; ˙BYTE 4 - TO BE GENERATED AT END ; ˙BIT ˙NAME ; ˙ 0 ˙$READ ; ˙ 1 ˙$WRITE ; ˙ 2 ˙$DC - DOUBLE, REAL CONVERSION ; ˙ 3 ˙$IC - INTEGER, OCTAL CONVERSION ; ˙ 4 ˙$LC - LOGICAL CONVERSION ; MISC: ˙.BYTE ˙0,0,0,0,0 ˙;MISCELLANEOUS MODES ; ; EXPONENTIATION GLOBAL MAP ; ; ˙BYTE ˙BASE MODE ; ˙ 0 ˙B (NOT ALLOWED) ; ˙ 1 ˙I ; ˙ 2 ˙I ; ˙ 3 ˙R ; ˙ 4 ˙D ; ˙ 5 ˙C ; ; ˙BIT ˙EXPONENT MODE ; ˙ 0 ˙B (NOT ALLOWED) ; [EQ ˙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 ˙(SP)+,R1 ˙BR ˙EQUL05 EQUL02: ˙ADD ˙#4,SP ˙RTS ˙PC ; ˙EQVBDS ; ; CHECK THE SUBSCRIBTS USED IN EQUIVALENCE/DATA ; ARE WITHIN DECLARED LIMITS ;\TLY IN CORE LOW: ˙0 HIGH: ˙0 DISP: ˙0 TRA: ˙0 TEMP: ˙0,0,0,0,0 ˙;TEMPORARIES FOR SAVING GROCERIES IN ; ; ; TRANSFER VECTORS ; ˙.GLOBL ˙END003,SYNX,SCANNR,EXECUT,ALOCAT ˙.GLOBL ˙OUTCST,SIZESM,SIZESN,SIZESQ,SIZT,END1 ˙.GLOBL ˙OV1JMP,OV2JMP,OV3JMP,OV4JMP,OV5JMP ˙.GLOBL ˙ENDFIL,IMPLIC,ASF,FUNCTO ˙.GLOBL ˙ASGN,OUTSL,HDRGEN,TFUN ˙.GLOBL ˙CONTIN,RETURN,$DCI,$RCI,DODON ˙.GLOBL ˙TYPE,LSTITM,QADBOK,OV6JMP END1: ˙INC ˙DISP ˙;VECTOR 32 SIZT: ˙INC ˙DISP ˙;VECTOR 31 SIZESQ: ˙INC ˙DISP ˙;VECTOR] ˙MOVB ˙TLGTH(R0),R0 ˙;GET THE LENGTH ˙ADD ˙R0,FNSTK ˙;PLACE LENGTH AWAY ˙MOV ˙#SVSP01,R4 ˙;GET PROTOTYPE ADDRESS ˙JSR ˙PC,PUTNAM ˙;GET THE NAME ˙BITB ˙BITM+0,MISC ˙;HAS A SVSP HAPPENED BEFORE? ˙BNE ˙SVSP02 ˙ ˙;YES ˙BISB ˙BITM+0,MISC ˙;SET GENERATED ˙JSR ˙PC,OUTGL ˙;GENERATE THE GLOBAL ˙JSR ˙PC,EOL ˙ ˙;END OF LINE SVSP02: ˙JSR ˙PC,OUTNAM ˙JSR ˙PC,OUTCOM ˙;OUTPUT A COMMA ˙MOV ˙-(R5),R3 ˙;GET THE LABEL ˙MOVB ˙#'F,R0 ˙JSR ˙PC,OUTSER ˙;OUTPUT THE LABEL XX: ˙JMP ˙SUB016 ; SVSP01: ˙^˙ 1 ˙I ; ˙ 2 ˙I ; ˙ 3 ˙R ; ˙ 4 ˙D ; ˙ 5 ˙C (NOT ALLOWED) ; ˙.GLOBL ˙EXPMAP EXPMAP: ˙.BYTE ˙0,0,0,0,0,0 ˙.EVEN ENDCLR ˙= ˙. ˙;END OF AREA NEEDING CLEARING ; ; ˙MASKS ; BITM: ˙.BYTE ˙1 ˙;0 ˙.BYTE ˙2 ˙;1 ˙.BYTE ˙4 ˙;2 ˙.BYTE ˙10 ˙;3 ˙.BYTE ˙20 ˙;4 ˙.BYTE ˙40 ˙;5 ˙.BYTE ˙100 ˙;6 ˙.BYTE ˙200 ˙;7 ; ; ; ; ; NAME TEMPORARY - USED BY GLOBAL GENERATOR ; PUTWK: ˙PUTA ˙ ˙;POINTER TO TEMPORARY PUTA: ˙.WORD ˙0,0,0,0,0,0 ˙;CAN'T HAVE MORE THAN 12 CHARS ; _ ˙ 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 ˙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)` 30 SIZESN: ˙INC ˙DISP ˙;VECTOR 29 SIZESM: ˙INC ˙DISP ˙;VECTOR 28 OUTCST: ˙INC ˙DISP ˙;VECTOR 27 OV6JMP: ˙INC ˙DISP ˙ ˙;VECTOR 26 TYPE: ˙INC ˙DISP ˙ ˙;VECTOR 25 LSTITM: ˙INC ˙DISP ˙;VECTOR 24 QADBOK: ˙INC ˙DISP ˙;VECTOR 23 DODON: ˙INC ˙DISP ˙;VECTOR 22 $RCI: ˙INC ˙DISP ˙;VECTOR 21 $DCI: ˙INC ˙DISP ˙;VECTOR 20 RETURN: ˙INC ˙DISP ˙;VECTOR 19 CONTIN: ˙INC ˙DISP ˙;VECTOR 18 HDRGEN: ˙INC ˙DISP ˙;VECTOR 17 OUTSL: ˙INC ˙DISP ˙;VECTOR 16 ASGN: ˙INC ˙DISP ˙;VECTOR 15 OV5JMP: ˙INC ˙DISP ˙;VECTOR 14 a.ASCII ˙/ ˙$SVSP/ ˙.BYTE ˙0 TLGTH: ˙.BYTE ˙2,2,2,4,8.,8. ˙.EVEN FUNC99: ˙BR ˙FUNCAL ; ; ARRAY REFERENCES ARE GENERATED HERE ; ARYREF: ˙MOV ˙#ARYR01,R4 ˙;GET PROTOTYPE ADDRESS ˙JSR ˙PC,PUTNAM ˙BIC ˙#177770,R0 ˙;CLEAR EXTRA BIT IN HEADER ˙MOV ˙R0,R4 ˙ADD ˙#60,R4 ˙ ˙;CONVERT TO ASCII ˙JSR ˙PC,PUTCHR ˙BITB ˙BITM(R0),GL1+1 ˙ ˙;DO WE NEED GLOBAL? ˙BNE ˙ARYR03 ˙ ˙;NO ˙BISB ˙BITM(R0),GL1+1 ˙;YES, SET GENERATED ˙JSR ˙PC,OUb;IMPLICIT TABLE - INITIALIZED TO STANDARD FORTRAN IMPLICIT ASSIGNMENTS ;BITS 5-3 OF THE BYTE CONTAINS THE DATA TYPE. IMPTAB: ˙.BYTE ˙030 ˙ ˙;A 0 ˙.BYTE ˙030 ˙ ˙;B 1 ˙.BYTE ˙030 ˙ ˙;C 2 ˙.BYTE ˙030 ˙ ˙;D 3 ˙.BYTE ˙030 ˙ ˙;E 4 ˙.BYTE ˙030 ˙ ˙;F 5 ˙.BYTE ˙030 ˙ ˙;G 6 ˙.BYTE ˙030 ˙ ˙;H 7 ˙.BYTE ˙020 ˙ ˙;I 10 ˙.BYTE ˙020 ˙ ˙;J 11 ˙.BYTE ˙020 ˙ ˙;K 12 ˙.BYTE ˙020 ˙ ˙;L 13 ˙.BYTE ˙020 ˙ ˙;M 14 ˙.BYTE ˙020 ˙ ˙;N 15 ˙.BYTE ˙030 ˙ ˙;O 16 ˙.BYTE ˙c,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 ; ˙INPUT: ˙R0 = LIST PREDECSSOR ; ˙OUTPUT: ˙R4 = GROUP MOVED ; EQUZ00: ˙MOV ˙#EQVCLS,R4 Ed OV4JMP: ˙INC ˙DISP ˙;VECTOR 13 OV3JMP: ˙INC ˙DISP ˙;VECTOR 12 ENDFIL: ˙INC ˙DISP ˙;VECTOR 11 FUNCTO: ˙INC ˙DISP ˙;VECTOR 10 ASF: ˙INC ˙DISP ˙;VECTOR 9 IMPLIC: ˙INC ˙DISP ˙;VECTOR 8 OV2JMP: ˙INC ˙DISP ˙;VECTOR 7 OV1JMP: ˙INC ˙DISP ˙;VECTOR 6 ALOCAT: ˙INC ˙DISP ˙;VECTOR 5 EXECUT: ˙INC ˙DISP ˙;VECTOR 4 SCANNR: ˙INC ˙DISP ˙;VECTOR 3 SYNX: ˙INC ˙DISP ˙;VECTOR 2 END003: ˙INC ˙DISP ˙;VECTOR 1 TFUN: ˙ ˙ ˙;VECTOR 0 ; ; ; - THIS ROUTINE GETS AN OVERLAY IF NECESSARY ; ˙AND THEN DISPATCHES TO IT VIeTGL ˙;OUTPUT THE GLOBAL ˙JSR ˙PC,EOL ARYR03: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙MOV ˙-(R5),R0 ˙;GET THE SERIAL NUMBER ˙BIC ˙#170000,R0 ˙;CLEAR OUT EXTRANEOUS BITS ˙JSR ˙PC,SERATR ˙;GET ITS TYPE ˙MOV ˙R0,R3 ˙ ˙;GET THE SERIAL NUMBER ˙JSR ˙˙PC,OUTCOM ˙MOVB ˙#'A,R0 ˙JSR ˙PC,OUTSER ˙TST ˙ARYASG ˙;IS THIS THE LEFT SIDE ˙ ˙ ˙ ˙;OF AN EXPRESSION?? ˙BNE ˙XX ˙ ˙;YES, SO SKIP SOME CODE ˙TST ˙IOL ˙ ˙;SKIP ALSO IF ˙BNE ˙XX ˙ ˙;I/O LIST ˙JSR ˙PC,EOL ˙ ˙;TERMINATE THE LINE ˙BIT ˙#004000,-f030 ˙ ˙;P 17 ˙.BYTE ˙030 ˙ ˙;Q 20 ˙.BYTE ˙030 ˙ ˙;R 21 ˙.BYTE ˙030 ˙ ˙;S 22 ˙.BYTE ˙030 ˙ ˙;T 23 ˙.BYTE ˙030 ˙ ˙;U 24 ˙.BYTE ˙030 ˙ ˙;V 25 ˙.BYTE ˙030 ˙ ˙;W 26 ˙.BYTE ˙030 ˙ ˙;X 27 ˙.BYTE ˙030 ˙ ˙;Y 30 ˙.BYTE ˙030 ˙ ˙;Z 31 ˙.EVEN ; ;TABLE TO CONVERT FROM DATA TYPE TO DATA SIZE ; TYPSIZ: ˙.BYTE ˙1 ˙ ˙ ˙;LOGICAL - 1 ˙.BYTE ˙4 ˙ ˙ ˙;LOGICAL - 2 ˙.BYTE ˙4 ˙ ˙ ˙;INTEGER (MAY BE 4 IF TWO WORD INTEGERS) ˙.BYTE ˙4 ˙ ˙ ˙;REAL ˙.BYTE ˙10 ˙ ˙ ˙;DOUBLE PRECISION ˙.BYTE ˙10 ˙ ˙ ˙;COgQUZ02: ˙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 ˙ ˙;BR => GO TO PREVIOUS CASE ˙MOV ˙@R0,R0 ˙BR hA THE ENTRY INDEX. IT IS ; ˙NOT NECESSARY TO GET AN OVERLAY IF R5 MATCHES OVNUM, ; ˙WHICH IMPLIES THAT THE OVERLAY IS ALREADY IN CORE. ; ˙CLR ˙TEMP ˙CLR ˙TEMP+2 ˙MOV ˙R5,TEMP+4 ˙MOV ˙R4,TEMP+6 ˙MOV ˙DISP,R5 ˙ ˙;GET THE ENTRY INDEX ˙CLR ˙DISP ˙ ˙;CLEAR POINTER FOR NEXT TIME AROUND ˙MOV ˙R5,-(SP) ˙;MULTIPLY ˙ASL ˙R5 ˙ ˙;BY ˙ADD ˙(SP)+,R5 ˙;THREE ˙ADD ˙#DESCR,R5 ˙;GET ADDRESS OF ITEMS RETLP: ˙MOVB ˙@R5,R4 ˙ ˙;GET THE OVERLAY NEEDED ˙CMPB ˙@R5,@OVNUM ˙;IS IT ALREADY IN CORE??? ˙BEi2(R5) ˙;IS NEXT OPERATION A STACK SAVE?? ˙BEQ ˙ARYR05 ˙;NO ˙MOV ˙#SVE,R4 ˙ ˙;GET THE ˙JSR ˙PC,PUTNAM ˙;SAVE PROTOTYPE ˙BITB ˙BITM+6,MISC+1 ˙;DO WE NEED A GLOBL?? ˙BNE ˙ARYR06 ˙ ˙;NO ˙JSR ˙PC,OUTGL ˙;PUT OUT THE GLOBAL ˙JSR ˙PC,EOL ˙ ˙;AND AN END OF LINE ARYR06: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙JMP ˙SUB043 ˙ ˙;AND CONTINUE ARYR05: ˙MOV ˙#ARYR02,R4 ˙;OUTPUT THE $GET ˙JSR ˙PC,PUTNAM ˙; PROTOTYPE ˙MOV ˙R2,R4 ˙ ˙;GET TYPE OF "GET" ˙ADD ˙#60,R4 ˙ ˙;CONVERT TO ASCII ˙JSR ˙PC,PUTCHR ˙;jMPLEX ˙.BYTE ˙0 ˙ ˙ ˙;HOLLERITH - ˙.BYTE ˙0 ˙ ˙ ˙;UNASSIGNED - ; ; VARIABLES INTRODUCED FOR THE COMMON AND ; EQUIVALENCE HANDLERS ; ; ˙LOCADB (5 WORDS) - A TEMP LOCATION FOR AN ; ˙ADB PRODUCED BY 'LSTITM' UNTIL ACCEPTED FOR ; ˙USE. LOCADB: ˙.WORD ˙0,0,0,0,0 ; ˙BLKNAM (7 BYTES) - A TEMP LOCATION FOR A BLOCK ; ˙NAME - UP TO SIX BYTES TERMINATED BY ZERO BLKNAM: ˙.WORD ˙0,0,0,0 ; ˙COMMON AND EQUIV TABLES ARE ALLOCATED Sk˙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,OUTSlQ ˙GO ˙ ˙;YES ˙MOV ˙OVTAB(R4),-(SP) ˙;GET ADDRESS OF DESCRIPTOR ˙MOV ˙#TLB,-(SP) ˙;GET LINK BLOCK ˙EMT ˙10 ˙ ˙;START THE TRANSFER ˙MOV ˙#TLB,-(SP) ˙;WE -MUST- WAIT ˙EMT ˙1 GO: ˙MOV ˙OVTAB(R4),R4 ˙;GET TABLE ADDRESS ˙CLR ˙TRA ˙ ˙;CLEAR HIGH ORDER PART ˙MOVB ˙1(R5),TRA ˙;GET ENTRY INDEX ˙ADD ˙@2(R4),TRA ˙;COMPUTE ˙MOV ˙@TRA,TRA ˙;FINAL TRANSFER ADDRESS ˙MOV ˙TEMP+6,R4 ˙;RESTORE R4 ˙TSTB ˙2(R5) ˙ ˙;DOES IT RETURN???? ˙BEQ ˙GO001 ˙ ˙;NO ˙MOV ˙OVNUM,TEMP+2 ˙;YES, SAVE OVERLAY POINTERmOUTPUT THE TYPE ˙BITB ˙BITM(R2),GL1+3 ˙;DO WE NEED A GLOBAL NOW? ˙BNE ˙ARYR04 ˙ ˙;NO ˙BISB ˙BITM(R2),GL1+3 ˙;YES, SET FLAG ˙JSR ˙PC,OUTGL ˙;GENERATE THE GLOBAL ˙JSR ˙PC,EOL ARYR04: ˙JSR ˙PC,OUTNAM ˙;GENERATE THE NAME ˙JMP ˙SUB016 ˙ ˙;RETURN TO MAIN LOOP ARYR01: ˙.ASCII ˙/ ˙$SBS/ ˙.BYTE ˙0 ˙.EVEN ; ; FUNCTION CALLS GET GENERATED HERE ; FUNCAL: ˙MOV ˙R1,-(SP) ˙;SAVE TEXT POINTER ˙MOV ˙R0,-(SP) ˙;SAVE R0 ˙MOV ˙-2(R5),RnEPARATELY ; ˙FROM REST OF SYMBOL TABLE TO FACILATATE RECOVERY COMLOW: ˙0 ˙;LOWEST ADDRESS IN COM/EQV TABLE COMNXT: ˙0 ˙;NEXT AVAILABLE LOC IN TABLE COMHGH: ˙0 ˙;HIGHEST ADDRESS IN COM/EQV TABLE ; ˙COMHED - POINTER TO THE HEAD OF THE COMMON ; ˙LIST STRUCTURE. COMHED: ˙COMUN ˙;INITIALLY ZERO ˙.GLOBL ˙COMUN,COMCLR COMUN: ˙.WORD ˙0 ˙;LINK TO NEXT BLOCK ˙.ASCII ˙'.$$$$.' ;BLOCK NAME ˙.WORD ˙0 ˙;NAME TERMINATOR COMCLR: ˙.WORD ˙0 ˙;LINK TO ITEM ; ˙EQVHED - POINTER TO HEAD OF EQV LIST STRUCTUTR ˙MOV ˙(SP)+,R0 ˙RTS ˙PC ˙.END p ˙MOV ˙R5,OVNUM ˙MOV ˙TEMP+4,R5 ˙;RESTORE R5 ˙MOV ˙(SP)+,TEMP+10 ˙;SAVE RETURN ADDRESS ˙JSR ˙PC,@TRA ˙ ˙;GO TO THE DESIRED ROUTINE ˙MOV ˙STATUS,TEMP ˙;REMEMBER STATUS ˙MOV ˙R5,TEMP+4 ˙MOV ˙R4,TEMP+6 ˙MOV ˙TEMP+2,R5 ˙BR ˙RETLP GO001: ˙MOV ˙R5,OVNUM ˙;REMEMBER OVERLAY POINTER ˙MOV ˙TEMP+4,R5 ˙;RESTORE R5 ˙TST ˙TEMP+2 ˙BNE ˙GO002 ˙ ˙;JUMP IF RTS IS REQUIRED ˙JMP ˙@TRA ˙ ˙;GO TO IT GO002: ˙MOV ˙TEMP,STATUS ˙;RESTORE STATUS ˙JMP ˙@TEMP+10 ˙;RETURN TO CALLER q0 ˙;GET THE SERIAL NUMBER ˙JSR ˙PC,SERATR ˙;GET FUNC13: ˙MOV ˙CURSYM,R0 ˙BIT ˙#040000,ENTYWD(R0) ;IS THIS AN ASF CALL?? ˙BNE ˙F13A ˙ ˙;YES, SKIP THE GLOBAL GENERATION ˙JSR ˙R5,OUTLN2 ˙FUNC11 ˙JSR ˙PC,OUTST ˙;OUTPUT THE NAME ˙JSR ˙PC,EOL F13A: ˙JSR ˙R5,OUTLN2 ˙FUNC04 ˙JSR ˙PC,OUTST ˙MOV ˙(SP)+,R0 ˙MOV ˙R2,-(SP) ˙;SAVE THE TYPE ˙SUB ˙#2,R5 ˙JSR ˙R5,OUTLN2 ˙;TRANSFER ˙FUNC05 ˙BIC ˙#177400,R0 ˙;GET THE PARAMETER COUNT ˙ASL ˙R0 ˙ ˙;CONVERT ˙ADD ˙#2,R0 ˙ ˙; TO A BRANCH OFFSETrRE EQVHED: ˙0 ˙;INITIALLY ZERO COMNUM: ˙.WORD ˙0 ; ;FOR DATA MODULE ; DATADB: ˙.WORD ˙0 DATLAB: ˙0 DATVSV: ˙0 DATVCT: ˙0 DATCSV: ˙0 DATCCT: ˙0 ALOKAT: ˙0 ˙.GLOBL ˙DATVCT,DATLAB ˙.GLOBL ˙COMNUM,DATADB,DATVSV,DATCSV,DATCCT,ALOKAT EQVH1: ˙.WORD ˙0 EQVH2: ˙.WORD ˙0 EQVCLS: ˙.WORD ˙0 EQVCOM: ˙.WORD ˙0 ˙.GLOBL ˙EQVH1,EQVH2,EQVCLS,EQVCOM ˙.GLOBL ˙LOCADB,BLKNAM,COMLOW,COMNXT,COMHGH,COMHED,EQVHED ˙.END s; ; PDP-11 FORTRAN COMPILER VERSION 001A ; ; ˙COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION ; ; ˙WRITTEN BY D. KNIGHT ; ; ˙NOTE: ˙THE USER SHOULD ASSUME THAT THESE ; ˙ ˙SOURCES WILL CHANGE DRASTICALLY ; ˙ ˙FOR THE NEXT RELEASE. ; ˙.TITLE ˙OTMP ˙.GLOBL ˙FB6,OV6 ˙.GLOBL ˙FB0,FB1,FB2,FB3,FB4,FB5,OV3,OV4,OV5 ˙.GLOBL ˙LOWLOC,TLB,OV0,OV1,OV2,START,LOW,HIGH ; ; THIS ROUTINE GETS THE OVERLAY GOODIES SET UP SO THAT THEY ; ˙ARE USEABLE WITHOUT WASTING OODLES OF TIME. THIS ROUTINE ; t; ; ROUTINE DESCRIPTOR ENTRIES. EACH ENTRY IS 3 BYTES LONG. ; ˙BYTE #1 IS THE OVERLAY NUMBER REQUIRED. BYTE #2 ; ˙IS THE ENTRY OFFSET OF THE ROUTINE. BYTE #3 IS ; ˙ZERO IF NO RETURN IS EXPECTED AND NON-ZERO IF A ; ˙RETURN IS EXPECTED. ; ; DESCR: ; ;TFUN ˙.BYTE ˙14,12,1 ˙;OVERLAY 6, ENTRY 6, RETURN ;END003 ˙.BYTE ˙0,4,0 ˙;OVERLAY 0, ENTRY 0, NO RETURN ;SYN2ER ˙.BYTE ˙0,6,1 ˙;OVERLAY 0, ENTRY 2, RETURN ;SCANNR ˙.BYTE ˙2,4,0 ˙;OVERLAY 1, ENTRu ˙MOV ˙R0,R3 ˙JSR ˙PC,OUTOCT FUNC06: ˙JSR ˙PC,EOL ˙ ˙;DO END-OF-LINE ˙TST ˙IOL ˙BGE ˙FUNC03 ˙JSR ˙R5,OUTLN2 ˙;GENERATE POLISH CALL FOR SPARSE CASE ˙FUNC09 ˙TST ˙(SP)+ ˙JMP ˙CALL05 FUNC03: ˙MOV ˙-(R5),R0 ˙;GET A WORD ˙BIC ˙#007777,R0 ˙CMP ˙#170000,R0 ˙;IS THIS AN INSERTED PARAMETER?? ˙BEQ ˙SPPAR ˙ ˙;YES ˙MOV ˙@R5,R0 ˙BPL ˙FUNC01 ˙BIT ˙#400,R0 ˙ ˙;IS THIS THE DEFINITION END? ˙BNE ˙FUNDON ˙ ˙;YES FUNC01: ˙JSR ˙PC,OUTTAB ˙JSR ˙R5,OUTCH2 ˙'+ ˙JSR ˙PC,SERATR ˙;GET ˙MOV ˙w˙IS WIPED OUT BY THE ROUTINE IT LOADS, SO DON'T TRY ; ˙TO FIND IT ONCE IT IS DONE. ; R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ˙.CSECT ; ; THE WHOLE FORTRAN WORLD STARTS UP HERE HWEN THIS HAPPENS. ; FORTRN: ˙MOV ˙#LOWLOC,SP ˙;SET UP THE STACK ˙MOV ˙SP,LOW ˙ ˙;SET LOW POINTER ˙MOV ˙#SETUP,R0 ˙;GET ADDRESS OF SETUP POINTERS ˙JSR ˙PC,GETDEV ˙;GET THE SYSTEM DEVICE ˙MOV ˙#TLB,-(SP) ˙;INIT THE ˙EMT ˙6 ˙ ˙;DISK FORT01: ˙MOV ˙(R0)+,R1 ˙;GET THE xY 0, NO RETURN ;EXECUT ˙.BYTE ˙6,4,0 ˙;OVERLAY 3, ENTRY 0, NO RETURN ;ALOCAT ˙.BYTE ˙4,6,1 ˙;OVERLAY 2, ENTRY 2, RETURN ;OV1JMP ˙.BYTE ˙2,6,0 ˙;OVERLAY 1, ENTRY 2, NO RETURN ;OV2JMP ˙.BYTE ˙4,10,0 ˙;OVERLAY 2, ENTRY 4, NO RETURN ;IMPLIC ˙.BYTE ˙2,10,0 ˙;OVERLAY 1, ENTRY 4, NO RETURN ;ASF ˙.BYTE ˙14,10,0 ˙;OVERLAY 6, ENTRY 4, NO RETURN ;FUNCTO ˙.BYTE ˙2,12,0 ˙;OVERLAY 1, ENTRY 6, NO RETURN ;ENDFIL ˙.BYTE ˙12,6,0 ˙;OVERLAY 5, ENTRY 2, NO RETURN ;OV3JMP ˙.BYTE ˙6,6,0 ˙;OVERLAY 3, EyCURSYM,R0 ˙;ADDRESS ˙JSR ˙PC,OUTST ˙;OUTPUT NAME OF SYMBOL ˙BR ˙FUNC06 ˙ ˙;OUTPUT THE NAME ; 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 ˙FNSTK,R0 ˙;GET THE STACK FUDGE FACTOR ˙BEQ ˙FUND01 ˙ ˙;NONE ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE ADD MNEMONIC ˙FUNC02 ˙MOV ˙R0,R3 ˙ ˙;NOW OUTPUT ˙JSR ˙PC,OUTOCT ˙;THE COUNT ˙JSR ˙R5,{FILE NAME ˙BEQ ˙FORT02 ˙ ˙;QUIT WHEN DONE ˙MOV ˙R1,-(SP) ˙;NOW FIND ˙CLR ˙-(SP) ˙ ˙;OUT WHERE ˙MOV ˙#TLB,-(SP) ˙;THE FILE IS ˙EMT ˙14 ˙ ˙;SO WE CAN USE IT ˙MOV ˙(R0)+,R1 ˙;GET ADDRESS OF TRANSFER BLOCK ˙MOV ˙(SP)+,@R1 ˙;REMEMBER THE START ADDRESS ˙ADD ˙#4,SP ˙ ˙;DISCARD THE REST ˙BR ˙FORT01 ˙ ˙;LOOKUP THE REST FORT02: ˙MOV ˙#SETUP1,R0 ˙;NOW SET UP FOR READING THE FILES FORT2A: ˙MOV ˙(R0)+,R1 ˙;GET TRAN BLOCK ADDRESS ˙BEQ ˙FORT03 ˙ ˙;QUIT WHEN DONE ˙MOV ˙R1,-(SP) ˙;GET THE LINK BLOC|NTRY 2, NO RETURN ;OV4JMP ˙.BYTE ˙10,6,0 ˙;OVERLAY 4, ENTRY 2, NO RETURN ;OV5JMP ˙.BYTE ˙12,10,0 ˙;OVERLAY 5, ENTRY 4, NO RETURN ;ASGN ˙.BYTE ˙6,10,0 ˙;OVERLAY 3, ENTRY 4, NO RETURN ;OUTSL ˙.BYTE ˙0,22,1 ˙;OVERLAY 0, ENTRY 16, RETURN ;HDRGEN ˙.BYTE ˙0,24,1 ˙;OVERLAY 0, ENTRY 20, RETURN ;CONTIN ˙.BYTE ˙0,10,1 ˙;OVERLAY 0, ENTRY 4, RETURN ;RETURN ˙.BYTE ˙0,12,1 ˙;OVERLAY 0, ENTRY 6, RETURN ;$DCI ˙.BYTE ˙0,14,1 ˙;OVERLAY 0, ENTRY 10, RETURN ;$RCI ˙.BYTE ˙0,16,1 ˙;OVERLAY 0, ENTRY 1}OUTLN2 ˙;OUTPUT THE ",SP" ˙FUNC08 ˙CLR ˙FNSTK ˙ ˙;NOW CLEAR THE COUNT FUND01: ˙JSR ˙R5,OUTLN2 ˙FUNC09 ˙CMP ˙4(SP),#CALL03 ˙;IS THIS A CALL STATEMENT? ˙BEQ ˙FUND03 ˙ ˙;YES IT IS ˙MOV ˙#FUNC10,R4 ˙;OUTPUT ˙JSR ˙PC,PUTNAM ˙;$PSHR ˙MOV ˙(SP)+,R2 ˙;NOW ˙MOV ˙R2,R4 ˙ADD ˙#60,R4 ˙ ˙;GENERATE THE TYPE ˙JSR ˙PC,PUTCHR ˙;AND OUTPUT IT ˙BITB ˙BITM(R2),GL1+4 ˙;CHECK FOR GLOBAL NEEDED ˙BNE ˙FUNC12 ˙ ˙;NOT NEEDED ˙BISB ˙BITM(R2),GL1+4 ˙;SET GENERATED FLAG ˙JSR ˙PC,OUTGL ˙;GENERATE THE GLOK ˙MOV ˙#FTMP,2(R1) ˙;I ONLY WANT ˙MOV ˙#2,4(R1) ˙;THE FIRST TWO WORDS NOW ˙MOV ˙#TLB,-(SP) ˙;GET THE OVERLAY DESCRIPTOR ˙EMT ˙10 ˙ ˙;GET TWO WORDS ˙MOV ˙#TLB,-(SP) ˙;AND WAIT ˙EMT ˙1 ˙ ˙; FOR COMPLETION ˙MOV ˙FTMP,2(R1) ˙;SET UP THE REAL CORE ADDRESS ˙MOV ˙FTMP+2,R2 ˙;AND GET THE REAL ˙CMP ˙R2,HIGH ˙BLO ˙FORT1A ˙MOV ˙R2,HIGH ˙ ˙;REMEMBER HIGHEST ADDRESS SO FAR FORT1A: ˙SUB ˙FTMP,R2 ˙ ˙;WORD COUNT ˙ASR ˙R2 ˙ ˙;WORD COUNT ˙MOV ˙R2,4(R1) ˙;AND SAVE IT TOO ˙BR ˙FORT2A ˙ ˙;GET DAT€2, RETURN ;DODON ˙.BYTE ˙0,20,1 ˙;OVERLAY 0, ENTRY 14, RETURN ;QADBOK ˙.BYTE ˙2,20,1 ˙;OVERLAY 1, ENTRY 14, RETURN ;LSTITM ˙.BYTE ˙2,16,1 ˙;OVERLAY 1, ENTRY 12, RETURN ;TYPE ˙.BYTE ˙2,14,1 ˙;OVERLAY 1, ENTRY 10, RETURN ;OV6JMP ˙.BYTE ˙14,6,0 ˙;OVERLAY 6, ENTRY 2, NO RETURN ;OUTCST ˙.BYTE ˙4,12,1 ˙;OVERLAY 2, ENTRY 6, RETURN ;SIZESM ˙.BYTE ˙4,14,1 ˙;OVERLAY 2, ENTRY 10, RETURN ;SIZESN ˙.BYTE ˙4,16,1 ˙;OVERLAY 2, ENTRY 12, RETURN ;SIZESQ ˙.BYTE ˙4,20,1 ˙;OVERLAY 2, ENTRY 14, RETURBAL ˙JSR ˙PC,EOL ˙ ˙;AND AN END OF LINE FUNC12: ˙JSR ˙PC,OUTNAM ˙;OUTPUT THE NAME ˙JSR ˙PC,EOL ˙ ˙;AND AN END OF LINE FUND02: ˙MOV ˙(SP)+,R1 ˙;AND RESTORE R1 ˙JMP ˙SUB022 FUND03: ˙TST ˙(SP)+ ˙ ˙;DISCARD STACK ITEM ˙BR ˙FUND02 ; FUNC04: ˙.ASCII ˙/ ˙.+2/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙JSR ˙%5,/ ˙.BYTE ˙0 FUNC05: ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙BR ˙.+/ ˙.BYTE ˙0 FUNC07: ˙.ASCII ˙/: ˙0/ ˙.BYTE ˙0 FUNC02: ˙.ASCII ˙/ ˙ADD ˙#/ ˙.BYTE ˙0 FUNC08: ˙.ASCII ˙/,%6/ ˙.BYTE ˙15,12,0 FUNC09: ˙.ASCIƒA ON THE OTHER OVERLAYS TOO ; ; NOW WE KNOW ALL ABOUT THE VARIOUS ROUTINES ; FORT03: ˙JMP ˙START ˙ ˙;GET THIS SHOW ON THE ROAD ; ; ROUTINE TO DETERMINE SYSTEM DEVICE ; GETDEV: ˙MOV ˙#CSIBLK,R0 ˙;GET ADDRESS OF CSI JUNK ˙MOV ˙@R0,-(SP) ˙;DO INITIAL ˙EMT ˙56 ˙ ˙; CSI1 ˙MOV ˙R0,@SP ˙ ˙;ADDRESS OF CSIBLK ˙EMT ˙57 ˙ ˙;DO CSI2 TO DETERMINE DEVICE ˙TST ˙(SP)+ ˙ ˙;POP JUNK FROM STACK ˙RTS ˙PC CSIBUF: ˙.WORD ˙2 ˙ ˙;OUTPUT SPEC .=.+14 LINBUF: ˙.WORD ˙14 ˙ ˙;FAKE BUFFER ˙.WORD ˙0 ˙.WORD ˙1„N ;SIZT ˙.BYTE ˙4,22,1 ˙;OVERLAY 2, ENTRY 16, RETURN ;END1 ˙.BYTE ˙6,12,1 ˙;OVERLAY 3, ENTRY 6, RETURN ˙.EVEN ; ; OVERLAY LINK BLOCK ; ˙.GLOBL ˙TLB ˙0 ˙ ˙;ERROR RETURN TLB: ˙0 ˙ ˙;DDB LINK ˙.RAD50 ˙/OVL/ ˙1 ˙.RAD50 ˙/DF/ ˙;ALL WE CAN HANDLE NOW IS RF11 ; ; OVERLAY DESCRIPTOR POINTERS ; OVTAB: ˙OV0 ˙;OVERLAY 0 - INITIALIZATION, TERMINATION ˙OV1 ˙;OVERLAY 1 - NON-EXECUTABLE #1 ˙OV2 ˙;OVERLAY 2 - NON-EXECUTABLE #2 ˙OV3 ˙;OVERLAY 3 - EXECUTABLE #1 ˙OV4 ˙;OVERLAY 4 - EXECUTABL…I ˙/ ˙JSR ˙%4,$POLSH/ ˙.BYTE ˙15,12,0 FUNC11: ˙.ASCII ˙/ ˙.GLOBL ˙/ ˙.BYTE ˙0 ARYR02: ˙.ASCII ˙/ ˙$GET/ ˙.BYTE ˙0 FUNC10: ˙.ASCII ˙/ ˙$PSHR/ ˙.BYTE ˙0 SVA: ˙.ASCII ˙/ ˙$SVA/ ˙.BYTE ˙0 SVP: ˙.ASCII ˙/ ˙$SVP/ ˙.BYTE ˙0 SVE: ˙.ASCII ˙/ ˙$SVE/ ˙.BYTE ˙0 ; CMP: ˙.ASCII ˙/ ˙$CM/ ˙.BYTE ˙0 ; OPTAB: ˙.BYTE ˙'O,'R ˙;OR ˙.BYTE ˙'A,'N ˙;AND ˙.BYTE ˙'N,'T ˙;NOT ˙.BYTE ˙'A,'D ˙;ADD ˙.BYTE ˙'S,'B ˙;SUBTRACT ˙.BYTE ˙'M,'L ˙;MULTIPLY ˙.BYTE ˙'D,'V ˙;DIVIDE OPT1: ˙.BYTE ˙'P,'W ˙;EXPO‡4 ˙.ASCII ˙/FTN000.OVL/ ˙.BYTE ˙15,12 CSIBLK: ˙.WORD ˙CSIBUF ˙.WORD ˙TLB ˙ ˙;LINK BLOCK ˙.WORD ˙DUM ˙ ˙;DUMMY FILE BLOCK ˙0 ˙4 DUM: ˙0 ˙ ˙ ˙;DUMMY FILE BLOCK ˙0 ˙0 ˙0 ˙0 ; FTMP: ˙0,0 ˙ ˙;WE PUT THE FWA AND WC OF THE OVERLAYS ˙ ˙ ˙;IN HERE TEMPORARILY ; SETUP: ˙FB0 ˙OV0 ˙FB1 ˙OV1 ˙FB2 ˙OV2 ˙FB3 ˙OV3 ˙FB4 ˙OV4 ˙FB5 ˙OV5 ˙FB6 ˙OV6 ˙0 SETUP1: ˙OV0 ˙OV1 ˙OV2 ˙OV3 ˙OV4 ˙OV5 ˙OV6 ˙0 ; ;OVERLAY 0 - FILE FTN000.OVL ˙0 ˙ ˙;ERROR RETURN ˙4 ˆE #2 ˙OV5 ˙;OVERLAY 5 - EXECUTABLE #3 ˙OV6 ˙;OVERLAY 6 - NON-EXECUTABLES #1B ; ; OVERLAY DESCRIPTORS - THESE ARE SET UP BY THE ; ˙INITIALIZATION (I HOPE) ; ˙.GLOBL ˙OV0,OV1,OV2,OV3,OV4,OV5,OV6 ; OVERLAY 0 - INITIALIZATION, TERMINATION, ERRORS OV0: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; OVERLAY 1 - NON-EXECUTABLES #1 OV1: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; OVERL‰NENTIATE 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 ; ; ; ˙.END ‹˙ ˙;OPEN FOR INPUT FB0: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/000/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ˙ ˙;PTC ; ;OVERLAY 1 - FILE FTN001.OVL ˙0 ˙ ˙;ERROR RETURN ˙4 ˙ ˙;OPEN FOR INPUT FB1: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/001/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ˙ ˙;PTC ; ;OVERLAY 2 - FILE FTN002.OVL ˙0 ˙ ˙;ERROR RETURN ˙4 ˙ ˙;OPEN FOR INPUT FB2: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/002/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ; ;OVERLAY 3 - FILE FTN003.OVL ˙0 ˙4 FB3: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/003/ ˙.RAD50 ˙ŒAY 2 - NON-EXECUTABLES #2 OV2: ˙0 ˙ ˙;STARTING DISK BLOCK ˙0 ˙ ˙;STARTING CORE ADDRESS ˙0 ˙ ˙;WORD COUNT ˙4 ˙ ˙;INPUT ˙0 ˙ ˙;RESERVED ; OVERLAY 3 - EXECUTABLES #1 OV3: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; OVERLAY 4 - EXECUTABLES #2 OV4: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; OVERLAY 5 - EXECUTABLES #3 OV5: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ; ;OVERLAY 4 - FILE FTN004.OVL ˙0 ˙4 FB4: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/004/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ; ;OVERLAY 5 - FILE FTN005.OVL ˙0 ˙4 FB5: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/005/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ; ; OVERLAY 6 - FILE FTN006.OVL ˙0 ˙4 FB6: ˙.RAD50 ˙/FTN/ ˙.RAD50 ˙/006/ ˙.RAD50 ˙/OVL/ ˙401 ˙ ˙;1,1 ˙0 ; ; WE HAVE REACHED THE END OF THE SUPER-SET-UP STUFF. ; ˙ISN'T IT ISOMETRIC?!!? ; ˙.END ˙FORTRN 0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; OVERLAY 6 - NON-EXECUTABLES #1B OV6: ˙0 ˙;STARTING DISK BLOCK ˙0 ˙;STARTING CORE ADDRESS ˙0 ˙;WORD COUNT ˙4 ˙;INPUT ˙0 ˙;RESERVED ; ; THIS IS THE END. SIMPLE, WASN'T IT???? ; ˙.END