; ; 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 ˙END029 ˙.GLOBL ˙OUTCHR,CURSYM,OUTSER,OUTCOL,OUTTAB ˙.GLOBL ˙OUTST,EOL,SYMBAS,OUTOCT,TYPSIZ ˙.GLOBL ˙OUTLN1,BLKDAT,RETURN,GENLAB,SERIAL ˙.GLOBL ˙NAMSER,SERATR,OUTSER,PARMKM,PARWD ˙.GLOBL ˙VALUE,OUTCHR,DLAB,RLAB,FLABL,DPC,RPC ˙.GLOBL ˙EXIT; ; 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 ˙IF021 ; ;IF PROCESSOR ;IF IDENTIFIED BY "IF(". R1 POINTS BEYOND THE LEFT PAREN. ;UPON ENTRY. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL CNXC1,SUBEXP,SCAN2A,EXPGEN,OUTLN,FLABL,IF,EOL .GLOBL CHTEST,OUTSER,CNXC .GLOBL ; ; 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 ˙HEAD02 ˙.GLOBL ˙ELOC,SCANN,ALOC,OVJMP,BEG,LGT ˙.GLOBL ˙OUTCSX,SIZXSM,SIZXSN,SIZXSQ,SIZXT ˙.CSECT ;OVERLAY 2 HEADER ;WARNING-HEAD01 AND HEAD02 MUST BE THE SAME LENGTH BEG: ˙. ˙;0-START OF OVERLAY LGT: ˙ELOC ˙;2-END OF OVERLAY ˙SCANN ˙;4-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 ˙NOEX1 ˙.GLOBL ˙GETLN,SCANN,EXEC ˙.GLOBL ˙MAIN,HDR,BLKDAT,BLKD,HDRGEN ˙.GLOBL ˙SCAN2A,GETSW,SEQNO ˙.GLOBL ˙ALOCAT,LINE,END003,END,SYN2ER ˙.GLOBL ˙ASF,EXECUT ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ,PARXWD,OUTLN2,OUTCH2,ENDPRO ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ; TAB ˙= ˙11 ; ; END PROCESSING - CLEAN UP THE WHOLE #!*X MESS. ; ; ; MULTIPLY INTEGER IN R4 BY INTEGER IN R3 ; ˙˙RESULT IS RETURNED IN R2 AND R4, R3 IS LEFT ; ˙UNCHANGED. ; ; ˙REGISTERS CHANGED - R2,R4. ; IMUL: ˙MOV ˙R1,-(SP) ˙;SAVE TEMPORARY ˙CLR ˙R1 ˙ ˙;CLEAR TEMPORARY ˙CLR ˙R2 ˙ ˙;CLEAR HIGH ORDER DESTINATION ˙MOV ˙#21,-(SP) ˙;SET COUNT OF 17 IMUL01: ˙RO ASGN,IFTAB,SCAN2A,IFJMP,OTOA,GENLAB .GLOBL ˙INHLAB,EXJMP ; ; IF011A: ˙JMP ˙IF011 ˙;INTERMEDIATE HELP ; ; ; ; IF: ˙JSR ˙PC,SUBEXP ˙MOV ˙R2,-(SP) ˙;SAVE VITAL REGISTERS, 1ST EXP ˙MOV ˙R0,-(SP) ˙JSR ˙PC,CNXC ˙MOV ˙2(SP),R2 ˙;RESTORE R2 ˙CMPB ˙(R1),#') ˙;IF TERM. NOT =")" THIS IS AN ILLEGAL IF ˙BNE ˙IF011A ˙JSR ˙PC,CNXC1 ˙;IF NEXT CH IS "=" THIS IS ˙ ˙ ˙ ˙;AN ASSIGNMENT STTEMENT ˙CMPB ˙(R1),#'= ˙BEQ ˙IF011A ˙;BR IF THIS IS AN ASSIGNMENT STTMNT ;PICK UP MODE OF EXPRESSION ˙MOV TART OF STATEMENT SCAN ˙ALOC ˙;6-ALLOCATE ROUTINE ˙OVJMP ˙;10-OVERLAY TRANSFER JUMP ˙OUTCSX ˙;12-OUTCST ˙SIZXSM ˙;14-SIZESM ˙SIZXSN ˙;16-SIZESN ˙SIZXSQ ˙;20-SIZESQ ˙SIZXT ˙;22-SIZT ˙.END ˙%6 PC ˙= ˙%7 ; SPACE ˙= ˙40 ; ; SCANNR IS THE MAIN CONTROL LOOP FOR THE COMPILER. IT CALLS ; ˙GETLN FOR A LINE OF TEXT AND THEN DISPATCHES TO ; ˙THE PROPER STATEMENT HANDLER. ; ; ˙EACH STATEMENT HANDLER IS DISPATCHED TO BY A "JSRPC,XXX". ; ˙UPON ENTRY TO THE HANDLER, R1 POINTS TO THE CHARACTER ; ˙WHERE THE RECOGNITION SCAN LEFT OFF. ; ; ˙EACH HANDLER IS, IN GENERAL, RESPONSIBLE FOR COMPLETE ; ˙PROCESSING OF THE REMAINDER OF THE LINE, UP TO AND ; ˙INCLUDING THE TERMINATOR BYTE. ; ; ˙RETU R ˙R1 ˙ ˙;KEEP TRACK ˙ROR ˙R2 ˙ ˙;OF WHAT BIT ˙ROR ˙R4 ˙ ˙; GETS MULTIPLIED ˙BCC ˙IMUL02 ˙ ˙;DON'T DO ANYTHING IF BIT CLEAR ˙ADD ˙R3,R2 ˙ ˙;ADD IN THE ˙ADC ˙R1 ˙ ˙;PARTIAL PRODUCT IMUL02: ˙DEC ˙@SP ˙ ˙;HAVE WE DONE IT ENOUGH? ˙BNE ˙IMUL01 ˙ ˙;NO ˙TST ˙(SP)+ ˙ ˙;POP THE COUNTER ˙MOV ˙(SP)+,R1 ˙;RESTORE R1 ˙RTS ˙PC ˙ ˙;AND RETURN TO CALLER ˙.GLOBL ˙ADBPWD CKAR01: ˙JSR ˙R5,OUTCH2 ˙'0 ˙BR ˙CKAR02 CKARY: ˙MOV ˙R0,-(SP) ˙CMP ˙R3,#1 ˙ ˙;IS IT AN ARRAY? ˙BNE ˙PSHG1 ˙ ˙;NO ˙MOV ˙R2 ˙R2,R5 ˙SWAB ˙R5 ˙ ˙;SHIFT TO LOW ORDER OF R5, ˙ASR ˙R5 ˙ ˙;MULTIPLIED BY 2 ˙ASR ˙R5 ˙ASR ˙R5 ˙BIC ˙#177761,R5 ˙;CLEAR ALL OTHER BITS ˙CMP ˙R5,#2 ˙ ˙;IF MODE NOT LOGICAL. ˙BGT ˙IF04 ˙ ˙;THIS IS AN ARITHMETIC IF IF041:; NOW GENERATE CODE FOR THE LOGICAL EXPR. ˙JSR ˙PC,GENLAB ˙;GENERATE STATEMENT LABEL IF ANY ˙JSR ˙PC,EXPGEN ˙;GENER ;GENERATE CODE FOR THE CALL TO THE OTS COMPARISON ROUTINE ;GENERATE ".GLOBL $TRTST" ˙MRN FROM THE HANDLER IS AS FOLLOWS: A NORMAL ; ˙RETURN WILL RETURN USING A "RTS PC" WITH THE V-BIT ; ˙OF THE STATUS WORD CLEAR. A RETURN WITH THE V-BIT ; ˙SET MAY ONLY OCCUR IF THE LINE IN QUESTION COULD ; ˙NOT BE OF THE ASSUMED TYPE. ; ; ˙ ˙EXAMPLE: COMMON=1 IS A LEGAL STATEMENT, BUT ; ˙ ˙THE COMMON PROCESSOR WOULD FIND IT ; ˙ ˙UNRECOGNIZABLE SO THE PROCESSOR WOULD SET THE ; ˙ ˙V-BIT BEFORE RETURNING. ; ; ˙THE IMPLICIT AND TYPE PROCESSORS ARE ENTERED ; ˙AS ABOVE EXCEPT THAT R0 CONTAIS THE M,-(SP) ˙;SAVE MODE ˙MOV ˙#5,R4 ˙ ˙;GENERATE PUSH ROUTINE ˙JSR ˙PC,TSTPSH ˙; IN CASE OF OVERFLOW ˙MOV ˙CURSYM,R5 ˙;GET POINTER TO ELEMENT ˙MOV ˙R0,R3 ˙ ˙;OUTPUT ˙MOV ˙#'A,R0 ˙ ˙; THE ADB ˙JSR ˙PC,OUTSER ˙; LABEL ˙JSR ˙PC,OUTCOL ˙;FOLLOWED ˙JSR ˙PC,OUTTAB ˙;BY A COLON AND A TAB ˙BIT ˙#010000,SERWD(R5) ;DO WE USE THE NAME? ˙BNE ˙CKAR01 ˙ ˙;NO ˙MOV ˙R5,R0 ˙JSR ˙PC,OUTST ˙;OUTPUT THE NAME CKAR02: ˙JSR ˙PC,EOL ˙ ˙;OUTPUT AN END OF LINE ˙MOV ˙ADBPWD(R5),R5 ˙;GET ADB ADDRESS ˙ADD ˙SYOV ˙#IF800,R4 ˙;GET ADDR OF ASCII STRING ˙MOV ˙#IF802-IF800,R5 ˙ ;SIZE OF STRING FOR .GLOBL DECLA ˙JSR ˙PC,OUTLN ˙JSR ˙PC,EOL ˙;OUTPUT CR/LF ˙MOV ˙#IF802-IF801,R5 ˙MOV ˙#IF801,R4 ˙JSR ˙PC,OUTLN ˙JSR ˙PC,EOL ˙;OUTPUT CR/LF ;NEXT GENERATE "JUMP OVER" ADDRESS FOR THE "FALSE" RETURN. ˙.GLOBL ˙OUTTAB ˙JSR ˙PC,OUTTAB ˙;WRITE A TAB TO OBJECT FILE ; ˙MOV ˙FLABL,R3 ˙;GUU A SERIAL# ˙MOV ˙R3,-(SP) ˙;SAVE SER.# ˙MOVB ˙#'F,R0 ˙ ˙;OUTPUT TO OBJECT DEVICE ˙JSR ˙PC,OUTSER ˙JSR ˙PC,EOL ˙;OU; ; 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 ˙NOEX2 ˙.GLOBL ˙GETLN,SCANN,EXEC ˙.GLOBL ˙MAIN,HDR,BLKDAT,BLKD,HDRGEN ˙.GLOBL ˙SCAN2A,GETSW,SEQNO ˙.GLOBL ˙ALOCAT,LINE,END003,END,SYN2ER ˙.GLOBL ˙ASF,EXECUT ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ODE OF ; ˙THE IMPLICIT OR TYPE STATEMENT ; ˙REGISTERS CHANGED - ALL. ; EXSTM: ˙JSR ˙PC,CKMAIN ˙;DO A HEADING JUST IN CASE ˙JMP ˙EXECUT ˙ ˙;GO DO THE EXECUTABLES END00: ˙TRAP+39. ˙ ˙;MISSING END STATEMENT ˙JSR ˙PC,END003 ˙;LINKAGE TO END HANDLER SCANN: ˙CLRB ˙GETSW ˙ ˙;NO, CLEAR GET SWITCH JUST IN CASE SCANR: ˙JSR ˙PC,SYN2ER ˙;PRINT ANY DIAGNOSTICS WHICH ˙ ˙ ˙ ˙;OCCURRED, THIS STATEMENT ˙.GLOBL ˙SYN2ER ˙INC ˙SEQNO ˙ ˙;ADVANCE SEQUENCE NUMBER ˙JSR ˙PC,GETLN ˙;GET A LINE OF TEXT ˙BVS ˙ENMBAS,R5 ˙;ADD IN THE FUDGE FACTOR ˙TST ˙(R5)+ ˙ ˙;SKIP OVER FIRST WORD ˙MOV ˙(R5)+,R3 ˙;GET THE DESCRIPTOR WORD ˙JSR ˙PC,OUTTAB ˙MOV ˙R3,R0 ˙JSR ˙PC,OUTOCT ˙;OUTPUT THE DESCRIPTOR ˙JSR ˙PC,EOL ˙ROL ˙R0 ˙ ˙;GET ˙ROL ˙R0 ˙ ˙; THE # OF DIMENSIONS ˙ROL ˙R0 ˙ ˙; INTO R0 ˙BIC ˙#177774,R0 ˙;CLEAR THE EXTRANEOUS BITS ˙MOV ˙#1,-(SP) ˙;PRESET SIZE TO 1 CKAR03: ˙MOV ˙(R5)+,R3 ˙;GET A ˙MOV ˙(SP)+,R4 ˙;GET COUNT ˙JSR ˙PC,IMUL ˙ ˙;ACCUMULATE ARRAY SIZE ˙TST ˙R2 ˙ ˙;DID IT GET TOO BIG? ˙BTPUT A CR.LF ˙INC ˙FLABL ;NOW IDENTIFY AND TRANSLATE THE STATEMENT IMBEDDED IN THIS IF. ˙MOV ˙#IFTAB,R0 ;ADDR OF TABLE OF EXECUTABLE PRO ˙JSR ˙PC,SCAN2A ˙;SEARCH TABLE FOR A MATCH ˙BVS ˙IF05 ;IF V=1, NO MATCH.TREAT AS ASSIGNMENT ˙INC ˙INHLAB ˙;SET "INHIBIT LABEL" SWITCH ˙ADD ˙#IFJMP,R0 ˙SUB ˙#EXJMP,R0 ˙JSR ˙PC,@EXJMP(R0) ˙;ELSE EXECUTE THE PROCESS ˙CLR ˙INHLAB ˙;CLEAR "INHIBIT LABEL" SWITCH IF051: ˙MOV ˙(SP),R3 ˙ ;NOW GENERATE ON THE STACK THELABEL ˙MOV ˙#005015,-(SP) ˙;PUT LINE˙%6 PC ˙= ˙%7 ; SPACE ˙= ˙40 ; ; SCANNR IS THE MAIN CONTROL LOOP FOR THE COMPILER. IT CALLS ; ˙GETLN FOR A LINE OF TEXT AND THEN DISPATCHES TO ; ˙THE PROPER STATEMENT HANDLER. ; ; ˙EACH STATEMENT HANDLER IS DISPATCHED TO BY A "JSRPC,XXX". ; ˙UPON ENTRY TO THE HANDLER, R1 POINTS TO THE CHARACTER ; ˙WHERE THE RECOGNITION SCAN LEFT OFF. ; ; ˙EACH HANDLER IS, IN GENERAL, RESPONSIBLE FOR COMPLETE ; ˙PROCESSING OF THE REMAINDER OF THE LINE, UP TO AND ; ˙INCLUDING THE TERMINATOR BYTE. ; ; ˙RETUD00 ˙ ˙;ASSUME END IF EOF OR EOM ˙TST ˙BLKDAT ˙ ˙;IS THIS ROUTINE ONLY BLOCK DATA?? ˙BEQ ˙SCAN1 ˙ ˙;NO ; SCAN2: ˙MOV ˙#BDATA,R0 ˙;PROTOTYPES ALLOWED IN BLOCK DATA ˙BR ˙SCAN3 SCAN1: ˙MOV ˙#NEXTBL,R0 ˙;NON-EXECUTABLE PROTOTYPES SCAN3: ˙JSR ˙PC,SCAN2A ˙;GO SEARCH FOR VERB ˙BVS ˙SCAN12 ˙ ˙;NOT FOUND ˙TST ˙BLKDAT ˙ ˙;IS THIS BLOCK DATA?? ˙BNE ˙SCAN5 ˙ ˙;JUMP IF YES ˙CMP ˙R0,#NXTBL1-NEXTBL ˙;SEE IF TYPE DECL. ˙BGE ˙SCAN7 ˙ ˙;IT GETS SPECIAL HANDLING ˙JSR ˙PC,CKMAIN ˙;GO SEE IF MAIN PROGRAMNE ˙PSHERR ˙ ˙;YES ˙MOV ˙R4,-(SP) ˙;SAVE SIZE INFORMATION ˙JSR ˙PC,OUTTAB ˙; COUNT ˙JSR ˙PC,OUTOCT ˙; ITEM AND OUTPUT IT ˙JSR ˙PC,EOL ˙DEC ˙R0 ˙ ˙;LOOP ˙BGT ˙CKAR03 ˙ ˙; AT MOST, THREE TIMES ˙MOV ˙(SP)+,R3 ˙;GET SIZE ˙MOV ˙(SP)+,R4 ˙;AND COMPUTE ˙MOVB ˙TYPSIZ(R4),R4 ˙;THE ˙JSR ˙PC,IMUL ˙ ˙;ACTUAL LENGTH ˙MOV ˙R4,R3 ˙ ˙;AND PLACE IN R3 ˙MOV ˙CURSYM,R0 ˙BIT ˙#170000,SERWD(R0) ;DO WE GENERATE THE ARRAY TOO? ˙BNE ˙PSHG1 ˙ ˙;NO ˙BCS ˙PSHERR ˙ ˙;ERROR IF ARRAY TOO BIG ˙MOV ˙R3,- TERM. ON STACK ˙SUB ˙#10,SP ˙ ˙;MAKE SPACE FOR 6 BYTES ˙MOV ˙SP,R2 ˙JSR ˙PC,OTOA ˙;CONVERT SERIAL # TO ASCII ˙MOV ˙#"$F,(SP) ˙;MOVE IN PREFIX TO LABEL ˙MOV ˙#": ,6(SP) ˙;MOVE IN SUFFIX ˙MOV ˙SP,R4 ˙ ˙;SET UP CALLING SEQ TO OUTPUT SY ˙MOV ˙#12,R5 ˙JSR ˙PC,OUTLN ˙;OUT GOES THE LINE ;LOGICAL IF DONE. CLEAN UP STACK AND RETURN SUCCESSFULLY. ˙MOV ˙14(SP),SP IF052: ˙TST ˙(SP)+ ˙ ˙;POP LAST WORD OFF STACK ˙CLV ˙ ˙ ˙;INDIRN FROM THE HANDLER IS AS FOLLOWS: A NORMAL ; ˙RETURN WILL RETURN USING A "RTS PC" WITH THE V-BIT ; ˙OF THE STATUS WORD CLEAR. A RETURN WITH THE V-BIT ; ˙SET MAY ONLY OCCUR IF THE LINE IN QUESTION COULD ; ˙NOT BE OF THE ASSUMED TYPE. ; ; ˙ ˙EXAMPLE: COMMON=1 IS A LEGAL STATEMENT, BUT ; ˙ ˙THE COMMON PROCESSOR WOULD FIND IT ; ˙ ˙UNRECOGNIZABLE SO THE PROCESSOR WOULD SET THE ; ˙ ˙V-BIT BEFORE RETURNING. ; ; ˙THE IMPLICIT AND TYPE PROCESSORS ARE ENTERED ; ˙AS ABOVE EXCEPT THAT R0 CONTAIS THE M HEADER NEEDED ˙JSR ˙PC,@NEXJMP(R0) ˙;JUMP TO NON-EXECUTABLES SCAN13: ˙BVC ˙SCANN ˙BR ˙SCAN14 ˙.GLOBL ˙OVJMP OVJMP: ˙JMP ˙@NEXJMP(R0) ˙;THIS ALLOWS OTHER OVERLAYS ˙ ˙ ˙ ˙;TO USE THE TABLES IN HERE SCAN5: ˙CMP ˙R0,#NXTBL1-BDATA ˙;CHECK FOR TYPE DECLARATION ˙BGE ˙SCAN20 ˙ ˙;JUMP IF IT IS ˙ADD ˙#BJMP-NEXJMP,R0 ˙;FUDGE THE POINTER ˙JSR ˙PC,@NEXJMP(R0) ˙;GO PROCESS STATEMENT ˙BVC ˙SCANR ˙ ˙;RETURN TO LOOP ˙BR ˙SCAN15 ˙ ˙;OR GIVE ERROR SCAN20: ˙SUB ˙#NXTBL1-BDATA,R0 ;FUDGE THE MODE POINTER(SP) ˙;REMEMBER SIZE TEMPORARILY ˙ASR ˙R3 ˙ ˙;CONVERT TO WORD COUNT ˙JSR ˙PC,TSTPSH ˙; THE BRANCHES!! ˙JSR ˙PC,OUTST ˙JSR ˙PC,OUTCOL ˙JSR ˙PC,EOL ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE ARRAY ˙GENP4 ˙MOV ˙(SP)+,R3 ˙; WITH ˙JSR ˙PC,OUTOCT ˙; IT'S SIZE ˙JSR ˙PC,EOL ˙ ˙; INFORMATION. PSHG1: ˙MOV ˙(SP)+,R0 PSHG3: ˙BR ˙PSHGEN CKR01: ˙BR ˙CKARY PSHERR: ˙TRAP+88. ˙ ˙;ARRAY TOO BIG? ˙BR ˙PSHG1 ˙ ˙;YEP!! ENDPRO: ˙TST ˙(SP)+ ˙TST ˙BLKDAT ˙ ˙;BLOCK DATA?? ˙BNE ˙GENBR ˙ ˙;YES END004: ˙TST ˙CATE SUCCESSFUL RETURN ˙RTS ˙PC ˙ ˙;EXIT IF05: ˙INC ˙INHLAB ˙;SET "INHIBIT LABEL" SWITCH ˙JSR ˙PC,ASGN ˙ ˙;TREAT WHAT FOLLOWS AS AN ASSIGN ˙CLR ˙INHLAB ˙;CLEAR "INHIBIT LABEL" SWITCH ˙BR ˙IF051 ; ;ARITHMETIC IF PROCESSOR ; IF04: ˙MOV ˙R5,-(SP) ˙;SAVE MODE ON STACK ˙JSR ˙PC,GENLAB ˙;GENERATE STATEMENT LABEL ETC. ˙JSR ˙PC,EXPGEN ˙;GENERATE CODE FOR SUBEXPRESSION ˙MOV ˙(SP)+,R0 ˙;PUT MODE IN R0 ˙MOV ˙IF950-4(R0),R4 ˙;GET ADDR OF ASCII STRING ˙MOV ˙#IF92-IF90,R5 ˙ ˙;LENGTH OF STRING ˙ODE OF ; ˙THE IMPLICIT OR TYPE STATEMENT ; ˙REGISTERS CHANGED - ALL. ; EXSTM: ˙JSR ˙PC,CKMAIN ˙;DO A HEADING JUST IN CASE ˙JMP ˙EXECUT ˙ ˙;GO DO THE EXECUTABLES END00: ˙TRAP+39. ˙ ˙;MISSING END STATEMENT ˙JSR ˙PC,END003 ˙;LINKAGE TO END HANDLER SCANN: ˙CLRB ˙GETSW ˙ ˙;NO, CLEAR GET SWITCH JUST IN CASE SCANR: ˙JSR ˙PC,SYN2ER ˙;PRINT ANY DIAGNOSTICS WHICH ˙ ˙ ˙ ˙;OCCURRED, THIS STATEMENT ˙.GLOBL ˙SYN2ER ˙INC ˙SEQNO ˙ ˙;ADVANCE SEQUENCE NUMBER ˙JSR ˙PC,GETLN ˙;GET A LINE OF TEXT ˙BVS ˙EN ˙BR ˙SCAN21 ˙ ˙;ASSUME "TYPE" SCAN12: ˙JSR ˙PC,CKMAIN ˙;SEE IF HEADER NEEDED SCAN14: ˙TST ˙BLKDAT ˙ ˙;CHECK FOR BLOCK DATA ˙BNE ˙SCAN15 ˙ ˙;DON'T CHECK ASF IF BLOCK DATA ˙JSR ˙PC,ASF ˙ ˙;GO TRY FOR ASF ˙BVS ˙EXSTM ˙ ˙;WASN'T ARITH. STMT. FNCT. ˙BR ˙SCANN ˙ ˙;GO BACK FOR A LINE SCAN15: ˙TRAP+4 ˙ ˙ ˙;BAD STATEMENT IN BLOCK DATA ˙BR ˙SCANR ; ; CKMAIN - SUBROUTINE TO CHECK FOR THE NEED OF A MAIN PROGRAM HEADER. ; ˙IF ONE IS NEEDED, THE HEADER GENERATOR IS CALLED WITH ; ˙THE NAME "MAIN." ;!ROUTIN ˙ ˙;JUMP ˙BEQ ˙END005 ˙ ˙; IF MAIN PROGRAM ˙MOV ˙#EL,R1 ˙ ˙;FAKE THE STRING ˙JSR ˙PC,RETURN ˙;GENERATE A RETURN ˙BR ˙END006 ˙ ˙;AND CONTINUE END005: ˙JSR ˙PC,GENLAB ˙;GET THE LABEL ˙JSR ˙R5,OUTLN2 ˙;GENERATE THE $EXIT ˙ENDP2 ˙JSR ˙PC,SYN2ER ˙;PRINT ANY DIAGNOSTICS ˙ ˙ ˙ ˙;WHICH OCCURED , LAST STATEMENT ˙.GLOBL ˙SYN2ER END006: ˙CLR ˙R0 PSHGEN: ˙INC ˙R0 ˙ ˙;ADVANCE TO NEXT SERIAL NUMBER ˙CMP ˙R0,SERIAL ˙;HAVE WE CHECKED THE WHOLE LIST? ˙BGT ˙GENBR ˙ ˙;YES, EXIT ˙CMP ˙ROU"JSR ˙PC,OUTLN ˙;OUTPUT .GLOBL FOR CALL ˙MOV ˙IF950-4(R0),R4 ˙;OUTPUT CALL TO COMPARISON STRIN ˙ADD ˙#IF91-IF90,R4 ˙MOV ˙#IF92-IF91,R5 ˙JSR ˙PC,OUTLN ;NOW FIND 3 DESTINATIONS FROM THE INPUT ;STRING AND OUTPUT EACH TO THE OBJECT DEVICE ˙MOV ˙#3,-(SP) ;SET UP LOOP COUNT FOR 3 STATEMENT LABELS IF045: ˙MOV ˙#005015,-(SP) ˙;PUT CR/LF ON STACK ˙MOV ˙#" ,-(SP) ˙MOV ˙#" ,-(SP) ˙MOV ˙#" ,-(SP) ˙MOV ˙SP,R5 ˙MOV ˙#027011,-(SP) ˙;PUT A TAB & A DOT ON STACK ˙JSR ˙PC,ISTAT ˙;GET STATEMENT L#D00 ˙ ˙;ASSUME END IF EOF OR EOM ˙TST ˙BLKDAT ˙ ˙;IS THIS ROUTINE ONLY BLOCK DATA?? ˙BEQ ˙SCAN1 ˙ ˙;NO ; SCAN2: ˙MOV ˙#BDATA,R0 ˙;PROTOTYPES ALLOWED IN BLOCK DATA ˙BR ˙SCAN3 SCAN1: ˙MOV ˙#NEXTBL,R0 ˙;NON-EXECUTABLE PROTOTYPES SCAN3: ˙JSR ˙PC,SCAN2A ˙;GO SEARCH FOR VERB ˙BVS ˙SCAN12 ˙ ˙;NOT FOUND ˙TST ˙BLKDAT ˙ ˙;IS THIS BLOCK DATA?? ˙BNE ˙SCAN5 ˙ ˙;JUMP IF YES ˙CMP ˙R0,#NXTBL1-NEXTBL ˙;SEE IF TYPE DECL. ˙BGE ˙SCAN7 ˙ ˙;IT GETS SPECIAL HANDLING ˙JSR ˙PC,CKMAIN ˙;GO SEE IF MAIN PROGRAM$ ˙REGISTERS CHANGED - R4,R5. ; CKMAIN: ˙CMP ˙R0,#HDRN-NEXTBL ;IS THIS SUBROUTINE OR FUNCTION? ˙BLE ˙CK1 ˙ ˙;YES CKM1: ˙TST ˙HDR ˙ ˙;IS HEADER ALREADY DONE? ˙BNE ˙CK1 ˙ ˙;EXIT IF DONE ˙MOV ˙R0,-(SP) ˙;SAVE STATEMENT TYPE ˙MOV ˙R1,-(SP) ˙MOV ˙#MAIN,R1 ˙;GET ADDRESS OF "MAIN." ˙MOV ˙#MODNAM,R0 ˙.GLOBL ˙PACK00 ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLR ˙ROUTIN ˙.GLOBL ˙ROUTIN ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R0 ˙;RESTORE STATEMENT TYPE CK1: ˙RTS ˙PC ˙%TIN,#2 ˙;IS THIS A FUNCTION? ˙BEQ ˙PSHG2 ˙ ˙;YES, DON'T SKIP THE FUNCTION NAME ˙CMP ˙R0,NAMSER ˙;IS THIS THE ROUTINE NAME? ˙BEQ ˙PSHGEN ˙ ˙;YES, SKIP IT PSHG2: ˙JSR ˙PC,SERATR ˙;FIND OUT ABOUT GOODIES ˙BVS ˙PSHGEN ˙ ˙;ALL DONE WHEN OVERFLOW OCCURS ˙TST ˙R3 ˙ ˙;IS IT SIMPLE VARIABLE OR CONSTANT ˙BGT ˙CKR01 ˙ ˙;NO, IGNORE IT ˙MOV ˙R0,-(SP) ˙;SAVE SERIAL NUMBER ˙MOV ˙R3,-(SP) ˙;SAVE CLASS ˙MOV ˙R0,R3 ˙ ˙;GET THE SERIAL NUMBER ˙MOV ˙#'P,R0 ˙ ˙;AND THE MNEMONIC ˙JSR ˙PC,OUTSER ˙;GENERATE&ABLE ˙TST ˙R4 ˙;CHECK FOR NO STTMNT FOUND ˙BEQ ˙IF042 IF044: ˙MOV ˙SP,R4 ˙;ELSE WRITE IT OUT ˙MOV ˙#12,R5 ˙JSR ˙PC,OUTLN IOF421: ˙ADD ˙#12,SP ˙ ˙;BACK UP THE STACK ˙DEC ˙(SP) ˙ ˙;REDUCE LOOP COUNT ˙BEQ ˙IF0431 ˙;EXIT IF 0. ELSE... ˙CMPB ˙(R1),#', ˙;DOES A COMMA FOLLOW? ˙BNE ˙IF042 ˙;IF NOT, ERROR ˙JSR ˙PC,CNXC1 ˙;ELSE STEP OVER COMMA ˙BR ˙IF045 ;3 STATEMENT LABELS HAVE BEEN PROCESSED. ;CLEAN UP AND GET OUT. IF0431: ˙MOV ˙2(SP),SP ˙;POP EVERYTHING OFF STACK ˙BR ˙IF052 IF042: ˙TR' HEADER NEEDED ˙JSR ˙PC,@NEXJMP(R0) ˙;JUMP TO NON-EXECUTABLES SCAN13: ˙BVC ˙SCANN ˙BR ˙SCAN14 ˙.GLOBL ˙OVJMP OVJMP: ˙JMP ˙@NEXJMP(R0) ˙;THIS ALLOWS OTHER OVERLAYS ˙ ˙ ˙ ˙;TO USE THE TABLES IN HERE SCAN5: ˙CMP ˙R0,#NXTBL1-BDATA ˙;CHECK FOR TYPE DECLARATION ˙BGE ˙SCAN20 ˙ ˙;JUMP IF IT IS ˙ADD ˙#BJMP-NEXJMP,R0 ˙;FUDGE THE POINTER ˙JSR ˙PC,@NEXJMP(R0) ˙;GO PROCESS STATEMENT ˙BVC ˙SCANR ˙ ˙;RETURN TO LOOP ˙BR ˙SCAN15 ˙ ˙;OR GIVE ERROR SCAN20: ˙SUB ˙#NXTBL1-BDATA,R0 ;FUDGE THE MODE POINTER( ˙;AND RETURN ; ; THIS CODE HANDLES QUICKLY FUNCTION CALLS WITH EXPLICIT ; ˙TYPING. ; SCAN7: ˙SUB ˙#NXTBL1-NEXTBL,R0 ˙;FUDGE THE MODE POINTER ˙MOV ˙R0,-(SP) ˙;SAVE TYPE FLAG FOR LATER USE ˙MOV ˙#FNTBL,R0 ˙;CHECK FOR "FUNCTION". ˙JSR ˙PC,SCAN2A ˙;GO SEE IF PRESENT ˙BVC ˙SCAN9 ˙ ˙;IT WAS THERE ˙MOV ˙(SP)+,R0 ˙;IT WASN'T, SO IT IS "TYPE". SCAN21: ˙MOV ˙#TYPE,-(SP) ˙;SET ROUTINE ADDRESS ˙JSR ˙PC,CKM1 ˙ ˙;SET UP HEADER IF NEEDED ˙BR ˙SCAN8 ˙ ˙;GO PROCESS TYPE. SCAN9: ˙MOV ˙(SP)+,R0 ˙;GET T) A LABEL ˙JSR ˙R5,OUTLN2 ˙;GENERATE PART OF ˙PSH001 ˙ ˙ ˙;THE PROTOTYPE ˙CMP ˙R2,#6 ˙ ˙;IS IT ASCII?? ˙BEQ ˙PSHG4 ˙ ˙;YES ˙CMP ˙R2,#3 ˙ ˙;IS IT REAL?? ˙BEQ ˙PSHRL2 ˙ ˙;YES ˙BGT ˙PSHDBX ˙ ˙;NO, HANDLE DOUBLE/COMPLEX PSHG4: ˙MOV ˙CURSYM,R0 ˙;IT IS INTEGER/LOGICAL/BYTE ˙TST ˙(SP) ˙ ˙;IS IT A CONSTANT?? ˙BMI ˙PSH013 ˙ ˙;YES ˙BIT ˙#PARMKM,PARWD(R0) ;IS IT A PARAMETER? ˙BEQ ˙PSHPI ˙ ˙;NO ˙JSR ˙PC,PSHP ˙ ˙;YES, GENERATE SPECIAL FORM ˙BR ˙PSH014 PSHPI: ˙JSR ˙PC,OUTST ˙;OUTPUT SYMBOL NA*AP +83. ˙;IMPROPER DESTINATION LABEL SEQU ˙ADD ˙#12,SP ˙;CLEAN UP STACK ˙BR ˙IF0431 IF043:IF010: ˙SEV ˙ ˙ ˙;INDICATE UNSUCCESSFUL RETURN ˙RTS ˙PC IF011: ˙MOV ˙(SP),SP ˙ ˙;CLEAN UP STACK ˙TST ˙(SP)+ ˙BR ˙IF010 ; ;ISTAT GETS A STATEMENT # FROM THE SOURCE STRING. . ; ˙(R1)=CURRENT CHAR. (1ST TO LOOK AT); SITS ON TERM AT END ; ˙(R5)=WHERE RESULT SHOULD GO R4 CLOBBERED ISTAT: ˙CLR ˙R4 ˙;INITIALIZE CH COUNT IST2: ˙CMP ˙R4,#5 + ˙BR ˙SCAN21 ˙ ˙;ASSUME "TYPE" SCAN12: ˙JSR ˙PC,CKMAIN ˙;SEE IF HEADER NEEDED SCAN14: ˙TST ˙BLKDAT ˙ ˙;CHECK FOR BLOCK DATA ˙BNE ˙SCAN15 ˙ ˙;DON'T CHECK ASF IF BLOCK DATA ˙JSR ˙PC,ASF ˙ ˙;GO TRY FOR ASF ˙BVS ˙EXSTM ˙ ˙;WASN'T ARITH. STMT. FNCT. ˙BR ˙SCANN ˙ ˙;GO BACK FOR A LINE SCAN15: ˙TRAP+4 ˙ ˙ ˙;BAD STATEMENT IN BLOCK DATA ˙BR ˙SCANR ; ; CKMAIN - SUBROUTINE TO CHECK FOR THE NEED OF A MAIN PROGRAM HEADER. ; ˙IF ONE IS NEEDED, THE HEADER GENERATOR IS CALLED WITH ; ˙THE NAME "MAIN." ;,YPE OF FUNCTION CALL ˙ASR ˙R0 ˙ ˙;GET THE ˙MOVB ˙MODE(R0),R0 ˙; SELECTED MODE ˙JSR ˙PC,FUNCTO ˙ ˙;AND GO TO SPECIAL FUNCTION ENTRY ˙BR ˙SCAN13 ; ; IMPLICIT PROCESSING OCCURS HERE ; SCAN18: ˙MOV ˙#IMPLIC,-(SP) ˙BR ˙SCAN17 ; ; TYPE PROCESSING HAPPENS NICELY HERE ; SCAN6: ˙MOV ˙#TYPE,-(SP) ˙;GET TYPE DISPATCH ADDRESS SCAN17: ˙MOV ˙#NXTBL1,R0 ˙;GET ADDRESS OF TYPE LIST ˙JSR ˙PC,SCAN2A ˙;GET THE TYPE DECLARATION ˙BVS ˙SCAN11 ˙ ˙;ILLEGAL TYPE STATEMENT SCAN8: ˙ASR ˙R0 ˙ ˙;GET BYTE INDEX -ME PSH014: ˙JSR ˙R5,OUTLN2 ˙;ADD THE REST OF THE INSTRUCTION ˙PSH004 ˙JSR ˙R5,OUTLN2 ˙;NOW OUTPUT THE JUMP ITSELF ˙PSH005 PSHEND: ˙MOV ˙#3,R4 ˙JSR ˙PC,TSTPSH ˙TST ˙@SP ˙ ˙;CHECK CLASS ˙BEQ ˙GENVAR ˙ ˙;IF VARIABLE GO HANDLE IT ˙MOV ˙(SP)+,R3 ˙MOV ˙CURSYM,R0 ˙;GET SYMBOL TABLE ENTRY ADDRESS ˙JSR ˙PC,OUTST ˙;OUTPUT SYMBOL NAME ˙JSR ˙PC,OUTCOL ˙;OUTPUT A COLON ˙MOV ˙CURSYM,R0 ˙;GET ˙MOV ˙@R0,R5 ˙ ˙; THE ˙BIC ˙#177400,R5 ˙; NUMBER OF DATA ITEMS ˙ADD ˙#VALUE,R0 ˙;GET POINTER TO VA. ˙BEQ ˙IST1 ˙ ˙;ARE WE DONE BECAUSE COUNT IS EX ˙JSR ˙PC,CHTEST ˙;NO, LOOK AT NEXT CH. ˙BPL ˙IST1 ˙;IF NOT DIGIT, EXIT ˙MOVB ˙(R1),(R5)+ ˙;ELSE MOVE IT OUTPUT ˙JSR ˙PC,CNXC1 ˙;GET NEXT CH. ˙INC ˙R4 ˙BR ˙IST2 IST1: ˙RTS ˙PC ; ;CONSTANTS FOR GENERATING CODE TO CALL THE ;OTS ARITHMETIC COMPARISON ROUTINES ; IF90: ˙.ASCII ˙/ ˙.GLOBL/ IF91: ˙.ASCII ˙/ ˙$TSI/ ˙.BYTE ˙015,012 ˙;CR/LF IF92: ˙.ASCII ˙/ ˙.GLOBL/ IF93: ˙.ASCII ˙/ ˙$TSR/ ˙.BYTE ˙015,012 ˙;CR/LF IF94: ˙.ASCII ˙/ ˙.GLOBL/ IF/ ˙REGISTERS CHANGED - R4,R5. ; CKMAIN: ˙CMP ˙R0,#HDRN-NEXTBL ;IS THIS SUBROUTINE OR FUNCTION? ˙BLE ˙CK1 ˙ ˙;YES CKM1: ˙TST ˙HDR ˙ ˙;IS HEADER ALREADY DONE? ˙BNE ˙CK1 ˙ ˙;EXIT IF DONE ˙MOV ˙R0,-(SP) ˙;SAVE STATEMENT TYPE ˙MOV ˙R1,-(SP) ˙MOV ˙#MAIN,R1 ˙;GET ADDRESS OF "MAIN." ˙MOV ˙#MODNAM,R0 ˙.GLOBL ˙PACK00 ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLR ˙ROUTIN ˙.GLOBL ˙ROUTIN ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R0 ˙;RESTORE STATEMENT TYPE CK1: ˙RTS ˙PC ˙0INTO MODE TABLE ˙MOVB ˙MODE(R0),R0 ˙;GET MODE IN R0 ; ; THE FOLLOWING LINES ARE TEMPORARY AND ARE USED ONLY TO WARN ; ˙THE USER THAT THE COMPILER CAN HANDLE COMPLEX, BUT ; ˙THAT THE OBJECT TIME SYSTEM HAS NO PROVISIONS FOR ; ˙HANDLING COMPLEX. ; ; ˙WHEN THE OTS COMPLEX ROUTINES ARE COMPLETED, THE FOLLOWING ; ˙THREE LINES SHOULD BE DELETED. ; ˙CMPB ˙R0,#5 ˙ ˙;IS IT COMPLEX HE WANTS? ˙BNE ˙SCAN8A ˙ ˙;NO, LET IT PASS ˙TRAP+87. ˙ ˙;WARN HIM THAT IT IS A FUTURE ˙ ˙ ˙ ˙; FEATURE ; THIS IS TH1LUE PSHLP: ˙JSR ˙PC,OUTTAB ˙;OUTPUT A TAB ˙MOV ˙(R0)+,R3 ˙;GET A WORD OF VALUE ˙JSR ˙PC,OUTOCT ˙; AND OUTPUT THE VALUE ˙JSR ˙PC,EOL ˙ ˙; AND AN END OF LINE ˙TST ˙DLAB ˙BEQ ˙PSHLP1 ˙INC ˙DPC PSHLP1: ˙TST ˙RLAB ˙BEQ ˙PSHLP2 ˙INC ˙RPC PSHLP2: ˙SUB ˙#2,R5 ˙ ˙;DECREMENT DATA COUNT ˙BGT ˙PSHLP ˙ ˙;LOOP UNTIL VALUE COMPLETE ˙CLR ˙R4 ˙ ˙;FAKE THE COUNT ˙CMP ˙R2,#6 ˙ ˙;IS IT ASCII? ˙BNE ˙PSHG5 ˙ ˙;NO ˙CLR ˙R3 ˙ ˙;YES, SO OUTPUT ˙JSR ˙PC,OUTOCT ˙;A WORD OF ˙JSR ˙PC,EOL ˙ ˙;ZEROS ˙295: ˙.ASCII ˙/ ˙$TSD/ ˙.BYTE ˙015,012 ˙.EVEN IF950: ˙;INDEX TABLE INTO TABLE AT IF90 ˙IF90 ˙IF92 ˙IF94 ; ; ;GLOBL DECLARATION AND CALL TO OTS LOGICAL COMPARE ROUTINE ; IF800: ˙.ASCII ˙/ ˙.GLOBL/ IF801: ˙.ASCII ˙/ ˙$TRTST/ ˙.BYTE ˙015,012 ˙;CR/LF IF802=. ; ; ˙.END ; 3 ˙;AND RETURN ; ; THIS CODE HANDLES QUICKLY FUNCTION CALLS WITH EXPLICIT ; ˙TYPING. ; SCAN7: ˙SUB ˙#NXTBL1-NEXTBL,R0 ˙;FUDGE THE MODE POINTER ˙MOV ˙R0,-(SP) ˙;SAVE TYPE FLAG FOR LATER USE ˙MOV ˙#FNTBL,R0 ˙;CHECK FOR "FUNCTION". ˙JSR ˙PC,SCAN2A ˙;GO SEE IF PRESENT ˙BVC ˙SCAN9 ˙ ˙;IT WAS THERE ˙MOV ˙(SP)+,R0 ˙;IT WASN'T, SO IT IS "TYPE". SCAN21: ˙MOV ˙#TYPE,-(SP) ˙;SET ROUTINE ADDRESS ˙JSR ˙PC,CKM1 ˙ ˙;SET UP HEADER IF NEEDED ˙BR ˙SCAN8 ˙ ˙;GO PROCESS TYPE. SCAN9: ˙MOV ˙(SP)+,R0 ˙;GET T4E END OF THE TEMPORARY CODE - NASTY ISN'T IT????? SCAN8A: ˙JSR ˙PC,@(SP)+ ˙;DO "TYPE" OR "IMPLICIT" ˙BR ˙SCAN13 ˙ ˙;AND RETURN TO LOOP SCAN11: ˙CMP ˙@SP,#IMPLIC ˙;IS THE ERROR ON AN IMPLICIT?? ˙BEQ ˙SCAN19 ˙ ˙;YES, TELL USER ˙TST ˙(SP)+ ˙ ˙;OTHERWISE TRY TO FIND ˙BR ˙SCAN14 ˙ ˙; ANOTHER MATCH SCAN19: ˙TRAP+3 ˙ ˙ ˙;TELL USER THAT TYPE IS BAD ˙MOV ˙#2,R0 ˙ ˙;ASSUME HE MEANT INTEGER ˙BR ˙SCAN8A ˙ ˙;NOW GO TRY TO CONTINUE ; ; MODE TABLE TO MATCH ORDER OF N11 THRU N20. ; MODE: ˙.BYTE ˙0,1,2,5MOV ˙#1,R4 ˙ ˙;AND MAKE SURE WE DIDN'T PSHG5: ˙JSR ˙PC,TSTPSH ˙;OVERFLOW COUNTER ˙MOV ˙(SP)+,R0 ˙;REMEMBER SERIAL NUMBER ˙BR ˙PSHGEN ˙ ˙;GO BACK TO MAIN LOOP GENBR: ˙JMP ˙GENDON ˙ ˙;MID-WAY BRANCH PSHDBX: ˙BR ˙PSHDBL PSHRL2: ˙BR ˙PSHRL ˙.GLOBL ˙SERWD GENVAR: ˙MOV ˙2(SP),R0 ˙;GET SERIAL NUMBER ˙JSR ˙PC,SERATR ˙;GET MODE ˙MOV ˙CURSYM,R0 ˙BIT ˙#170000,SERWD(R0) ;DO I DARE GENERATE VAR?? ˙BNE ˙GENEX ˙ ˙;NO ˙BIT ˙#PARMKM,PARWD(R0) ;PARAMETER? ˙BNE ˙GENEX ˙ ˙;YES ˙MOV ˙R2,-(SP) ˙;YES 7YPE OF FUNCTION CALL ˙ASR ˙R0 ˙ ˙;GET THE ˙MOVB ˙MODE(R0),R0 ˙; SELECTED MODE ˙JSR ˙PC,FUNCTO ˙ ˙;AND GO TO SPECIAL FUNCTION ENTRY ˙BR ˙SCAN13 ; ; IMPLICIT PROCESSING OCCURS HERE ; SCAN18: ˙MOV ˙#IMPLIC,-(SP) ˙BR ˙SCAN17 ; ; TYPE PROCESSING HAPPENS NICELY HERE ; SCAN6: ˙MOV ˙#TYPE,-(SP) ˙;GET TYPE DISPATCH ADDRESS SCAN17: ˙MOV ˙#NXTBL1,R0 ˙;GET ADDRESS OF TYPE LIST ˙JSR ˙PC,SCAN2A ˙;GET THE TYPE DECLARATION ˙BVS ˙SCAN11 ˙ ˙;ILLEGAL TYPE STATEMENT SCAN8: ˙ASR ˙R0 ˙ ˙;GET BYTE INDEX F2,4,4,5,4,3,3 ˙.EVEN ; ; TABLE OF NON-EXECUTABLE PROTOTYPES ; NEXTBL: ˙N1 ˙N2 HDRN: ˙N10 ˙N3 ˙N3A BDATA: ˙N4 ˙N5 ˙N6 ˙N7 ˙N8 ˙N9 ˙N10A NXTBL1: ˙N11 ˙N12 ˙N13 ˙N14 ˙N15 ˙N16 ˙N17 ˙N18 ˙N19 ˙N20 ˙N21 ˙0 ; END OF PART 1 ; ; START OF PART 2 N1: ˙.ASCII ˙/SUBROUTINE/ N2: ˙.ASCII ˙/FUNCTION/ N10: ˙.ASCII ˙/BLOCKDATA/ N3: ˙.ASCII ˙/EXTERNAL/ N3A: ˙.ASCII ˙/DEFINEFILE/ N4: ˙.ASCII ˙/TYPE/ N5: ˙.ASCII ˙/DIMENSION/ N6: ˙.ASCII ˙/COMMON/ N7: ˙.ASCII ˙/EQUIE˙JSR ˙PC,OUTST ˙;GENERATE A NAME ˙MOV ˙(SP)+,R2 ˙;RESTORE R2 ˙BNE ˙GV1 ˙ ˙;NOT TYPE LOGICAL*1 ˙MOV ˙#GENP1,R4 ˙;SET UP ˙MOV ˙#1,R0 ˙ ˙;BYTE VAR. ˙BR ˙GENC GV1: ˙CMP ˙R2,#4 ˙ ˙;FOUR WORD? ˙BGE ˙GV2 ˙ ˙;YES ˙MOV ˙#GENP2,R4 ˙;SET UP ˙MOV ˙#2,R0 ˙ ˙;LOGICAL,INTEGER, OR REAL ˙BR ˙GENC GV2: ˙MOV ˙#GENP3,R4 ˙;SET UP ˙MOV ˙#4,R0 ˙ ˙;DOUBLE, COMPLEX GENC: ˙JSR ˙PC,OUTLN1 ˙;OUTPUT THE CHARACTERS ˙MOV ˙R0,R4 ˙JSR ˙PC,TSTPSH GENEX: ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R0 ˙JMP ˙PSHGEN PSH013: ˙AH; ; 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 ˙INIT ˙;COMPILER INITIALIZATION ˙.GLOBL ˙START ˙.GLOBL ˙EXIT .GLOBL ˙ALOKAT,BUFIN,CMDBUF,COMCLR,COMLOW,COMNXT .GLOBL ˙COMUN,ECNT,ENDCLR,EQVHED,ERRCUR,ERRS .GLOBL ˙FLABL,GBUF,HEAD1,HLGT1,INHD,INPBLK .GLOBL ˙ITOA,LINKI,LINKK,LINKL,LINKOL,LINKSLGINTO MODE TABLE ˙MOVB ˙MODE(R0),R0 ˙;GET MODE IN R0 ; ; THE FOLLOWING LINES ARE TEMPORARY AND ARE USED ONLY TO WARN ; ˙THE USER THAT THE COMPILER CAN HANDLE COMPLEX, BUT ; ˙THAT THE OBJECT TIME SYSTEM HAS NO PROVISIONS FOR ; ˙HANDLING COMPLEX. ; ; ˙WHEN THE OTS COMPLEX ROUTINES ARE COMPLETED, THE FOLLOWING ; ˙THREE LINES SHOULD BE DELETED. ; ˙CMPB ˙R0,#5 ˙ ˙;IS IT COMPLEX HE WANTS? ˙BNE ˙SCAN8A ˙ ˙;NO, LET IT PASS ˙TRAP+87. ˙ ˙;WARN HIM THAT IT IS A FUTURE ˙ ˙ ˙ ˙; FEATURE ; THIS IS TH""""""" """"""DDDDDDˆ@D€ˆˆˆˆˆ€ˆˆ@DD€ˆˆˆˆˆˆˆˆDDDDDDDDD """""ˆˆDDDDDD "ˆ "ADD€€B B Ct!§Ŕ4d”y›N9ŘĚ4d” 2›É2Đ4d” ›ÝYؚ4d”N›ÝY›4d”[›y:}4d”6€›y:ԁ4d”R^›ÝY ›4d”_Ÿ›É2Ň4d”bf›0"ĽŔ4d”jŚ› zÖ(4d”}•›ľzöŔ4d”„>x›É2Ó4d”™›t!íy4d”ĄŠ›X:RŔ4d”ŁŻ›X4d”Ş Ö›y:΁4d”­š›É2Ď4d”łť›KT˜:4d”˝ɛ$D˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙wWU˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙˙P+12. ˙ ˙;ILLEGAL TERMINATOR 8ŽP002: ˙RTS ˙PC ILLTAP: ˙TRAP+73. ˙ ˙;ILLEGAL SYNTAX ˙RTS ˙PC ; RWND: ˙.ASCII ˙/ ˙.GLOBL ˙$RWIND/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$RWIND/ ˙.BYTE ˙15,12,0 BAK: ˙.ASCII ˙/ ˙.GLOBL ˙$BCKSP/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$BCKSP/ ˙.BYTE ˙15,12,0 ENDF: ˙.ASCII ˙/ ˙.GLOBL ˙$ENDFL/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$ENDFL/ ˙.BYTE ˙15,12,0 ˙.END IDD ˙#VALUE,R0 ˙;SINGLE DATA WORD ITEM ˙JSR ˙R5,OUTCH2 ˙;OUTPUT THE ˙'# ˙ ˙ ˙;IMMEDIATE MODIFIER ˙MOV ˙(R0)+,R3 ˙;OUTPUT THE ˙JSR ˙PC,OUTOCT ˙; VALUE ˙BR ˙PSH014 ˙ ˙;RETURN TO LOOP PSHDBL: ˙MOV ˙DLAB,R5 ˙BNE ˙PSHDB1 ˙ ˙;LABEL ASSIGNED ˙MOV ˙FLABL,DLAB ˙;ASSIGN NEW LABEL ˙INC ˙FLABL ˙MOV ˙#-120.,DPC ˙;RESET PC ˙BR ˙PSHDBL ˙ ˙;TRY AGAIN PSHDB1: ˙MOV ˙#PSH007,R2 ˙;SET "DOUBLE" TAIL PSHCOM: ˙MOV ˙CURSYM,R0 ˙;OUTPUT ˙BIT ˙#PARMKM,PARWD(R0) ;PARAMETER?? ˙BEQ ˙PSHC1 ˙ ˙;NO ˙JSR ˙PC,PSJVALENCE/ N8: ˙.ASCII ˙/DATA/ N9: ˙.ASCII ˙/IMPLICIT/ N10A: ˙.ASCII ˙/END/ N11: ˙.ASCII ˙/LOGICAL*1/ N12: ˙.ASCII ˙/LOGICAL/ N13: ˙.ASCII ˙/INTEGER*2/ N14: ˙.ASCII ˙/INTEGER/ N15: ˙.ASCII ˙/DOUBLEPRECISION/ N16: ˙.ASCII ˙/DOUBLE/ N17: ˙.ASCII ˙/COMPLEX/ N18: ˙.ASCII ˙/REAL*8/ N19: ˙.ASCII ˙/REAL*4/ N20: ˙.ASCII ˙/REAL/ N21 ˙= ˙. ˙.EVEN ; END OF PART 2 ; ; FUNCTION PROTOTYPE FOR SPECIAL FUNCTION FORMS ; FNTBL: ˙N2 ˙N10 ˙0 ; ˙.GLOBL ˙SUBROU,FUNCTI,EXTERN,DIMENS,OV2JMP ˙.GLOBL ˙IKE END OF THE TEMPORARY CODE - NASTY ISN'T IT????? SCAN8A: ˙JSR ˙PC,@(SP)+ ˙;DO "TYPE" OR "IMPLICIT" ˙BR ˙SCAN13 ˙ ˙;AND RETURN TO LOOP SCAN11: ˙CMP ˙@SP,#IMPLIC ˙;IS THE ERROR ON AN IMPLICIT?? ˙BEQ ˙SCAN19 ˙ ˙;YES, TELL USER ˙TST ˙(SP)+ ˙ ˙;OTHERWISE TRY TO FIND ˙BR ˙SCAN14 ˙ ˙; ANOTHER MATCH SCAN19: ˙TRAP+3 ˙ ˙ ˙;TELL USER THAT TYPE IS BAD ˙MOV ˙#2,R0 ˙ ˙;ASSUME HE MEANT INTEGER ˙BR ˙SCAN8A ˙ ˙;NOW GO TRY TO CONTINUE ; ; MODE TABLE TO MATCH ORDER OF N11 THRU N20. ; MODE: ˙.BYTE ˙0,1,2,L .GLOBL ˙LOW,LSTBLK,LSTER,LSTEXT,OBJBLK,OBJER .GLOBL ˙OBJEXT,OBJLS,OUTPUT,SCANNR,SIZE,SRCIN .GLOBL ˙SRCLS,STCLR,SYNERR ˙.GLOBL ˙HIGH,COMHGH,COMLOW,SYMBAS,SIZE,SYMEND,SYMCUR ˙.GLOBL ˙SERIAL,SRCERR,SRCEXT,IMPTAB ˙.CSECT 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 ˙ ˙;WRIMHP1 ˙;YES, GENERATE SPECIAL FORM ˙JSR ˙R5,OUTLN2 ˙PSH012 ˙CMP ˙R2,#PSH007 ˙;IS IT REAL?? ˙BNE ˙PSHC2 ˙ ˙;NO ˙INC ˙DBLT ˙ ˙;SET THE SPECIAL DOUBLE FLAG ˙BR ˙PSHC3 PSHC2: ˙INC ˙RLT ˙ ˙;SPECIAL REAL FLAG PSHC3: ˙JSR ˙R5,OUTLN2 ˙PSH017 ˙˙MOV ˙R5,R3 ˙ ˙;NOW ˙MOV ˙#'F,R0 ˙ ˙;OUTPUT THE LABEL ˙JSR ˙PC,OUTSER ˙JSR ˙R5,OUTLN2 ˙PSH011 ˙BR ˙PSHC4 PSHC1: ˙JSR ˙R5,OUTCH2 ˙'# ˙JSR ˙PC,OUTST ˙; THE SYMBOL NAME ˙MOV ˙R2,R4 ˙ ˙;GET CODE "TAIL" ˙JSR ˙PC,OUTLN1 ˙; IS OUTPUT HERE ˙MOV ˙NMPLIC,TYPE,FUNCTO,DEFINE,DATA ; NEXJMP: ˙SUBROU ˙FUNCTI ˙BLOCKD ˙EXTERN ˙DEFINE BJMP: ˙SCAN6 ˙ ˙;SPECIAL HANDLING FOR "TYPE" ˙DIMENS ˙OV2JMP ˙;COMMON IS IN OVERLAY 2 ˙OV2JMP ˙;EQUIVALENCE IS IN OVERLAY 2 ˙DATA ˙SCAN18 ˙ ˙;SPECIAL HANDLING FOR "IMPLICIT" ˙END ; ; BLOCK DATA IS EASY TO HANDLE SO IS DONE HERE ; BLOCKD: ˙TSTB ˙@R1 ˙ ˙;END OF LINE?? ˙BEQ ˙BLOCK2 ˙ ˙;YES ˙TRAP+12. ˙ ˙;NO BLOCK2: ˙INC ˙BLKDAT ˙ ˙;DISALLOW EXECUTABLES ˙MOV ˙#BLKD,R1 ˙;GET ADDRESS OF "DATA." ˙MOO2,4,4,5,4,3,3 ˙.EVEN ; ; TABLE OF NON-EXECUTABLE PROTOTYPES ; NEXTBL: ˙N1 ˙N2 HDRN: ˙N10 ˙N3 ˙N3A BDATA: ˙N4 ˙N5 ˙N6 ˙N7 ˙N8 ˙N9 ˙N10A NXTBL1: ˙N11 ˙N12 ˙N13 ˙N14 ˙N15 ˙N16 ˙N17 ˙N18 ˙N19 ˙N20 ˙N21 ˙0 ; END OF PART 1 ; ; START OF PART 2 N1: ˙.ASCII ˙/SUBROUTINE/ N2: ˙.ASCII ˙/FUNCTION/ N10: ˙.ASCII ˙/BLOCKDATA/ N3: ˙.ASCII ˙/EXTERNAL/ N3A: ˙.ASCII ˙/DEFINEFILE/ N4: ˙.ASCII ˙/TYPE/ N5: ˙.ASCII ˙/DIMENSION/ N6: ˙.ASCII ˙/COMMON/ N7: ˙.ASCII ˙/EQUIPTE 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 ; ; ALL OF FORTRAN STARTS HERE. THE THREE REQUIRED FILES ; ˙ARE INITIALIZED AND A JUMP TO SCANNR IS MADE. ; START: ˙MOV ˙LOW,SP ˙ ˙;SET UP THE STACK ˙MOV ˙#SYNERR,-(SP) ˙;ADDRESS OF ERROR VECTOR ˙CLR ˙-(SP) ˙ ˙;ZERO STATUS ˙MOV ˙#1,-(SP) ˙;SET TRAP CALL ADDRESS ˙UTIL ˙ ˙ ˙;LET QR5,R3 ˙MOV ˙#'F,R0 ˙JSR ˙PC,OUTSER PSHC4: ˙JSR ˙PC,EOL ˙ ˙;GENERATE END OF LINE ˙JMP ˙PSHEND ˙ ˙;GO BACK TO MAIN LOOP PSHRL: ˙MOV ˙RLAB,R5 ˙BNE ˙PSHRL1 ˙ ˙;JUMP IF LABEL ASSIGNED ˙MOV ˙FLABL,RLAB ˙;ASSIGN ˙INC ˙FLABL ˙ ˙; NEW LABEL ˙MOV ˙#-120.,RPC ˙;AND ˙BR ˙PSHRL ˙ ˙;TRY AGAIN PSHRL1: ˙MOV ˙#PSH008,R2 ˙;POINT TO "REAL" TAIL ˙BR ˙PSHCOM GENDON: ˙MOV ˙#200.,R4 ˙JSR ˙PC,TSTPSH ˙;FORCE OUT THE LAST BIT OF CODE ; ; OUTPUT THE GLOBALS NECESSARY TO HOOK UP TO THE OTS. ; ˙.GLOBL ˙BIV ˙#MODNAM,R0 ˙.GLOBL ˙MODNAM ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLV ˙RTS ˙PC ˙ ˙;AND RETURN ; ˙.END SVALENCE/ N8: ˙.ASCII ˙/DATA/ N9: ˙.ASCII ˙/IMPLICIT/ N10A: ˙.ASCII ˙/END/ N11: ˙.ASCII ˙/LOGICAL*1/ N12: ˙.ASCII ˙/LOGICAL/ N13: ˙.ASCII ˙/INTEGER*2/ N14: ˙.ASCII ˙/INTEGER/ N15: ˙.ASCII ˙/DOUBLEPRECISION/ N16: ˙.ASCII ˙/DOUBLE/ N17: ˙.ASCII ˙/COMPLEX/ N18: ˙.ASCII ˙/REAL*8/ N19: ˙.ASCII ˙/REAL*4/ N20: ˙.ASCII ˙/REAL/ N21 ˙= ˙. ˙.EVEN ; END OF PART 2 ; ; FUNCTION PROTOTYPE FOR SPECIAL FUNCTION FORMS ; FNTBL: ˙N2 ˙N10 ˙0 ; ˙.GLOBL ˙COMMON,OV1JMP ˙.GLOBL ˙EQUIVA,IMPLIC,TYPE,FUNTMONITOR SET UP VECTOR ˙MOV ˙#100,-(SP) ˙;FIND ˙UTIL ˙ ˙ ˙;MACHINE SIZE ˙MOV ˙(SP)+,SIZE ˙;AND SAVE IT ˙MOV ˙#LINKK,-(SP) ˙;INITIALIZE KEYBOARD ˙INIT ˙MOV ˙#LINKL,-(SP) ˙;INITIALIZE ˙INIT ˙ ˙ ˙;TELEPRINTER ˙MOV ˙#HLGT1,R5 ˙;OUTPUT ˙MOV ˙#HEAD1,GBUF+6 ˙;THE ˙MOV ˙#DESC,R4 ˙;HEADING ˙JSR ˙PC,OUTPUT ˙;WHICH IS STORED IN THE TABLES FORT09: ˙MOV ˙#TEND,R5 ˙;GET COUNT ˙MOV ˙#TITLE,GBUF+6 ˙MOV ˙#DESC,R4 ˙;AND I/O DESCRIPTOR ˙JSR ˙PC,OUTPUT ˙;TELL USER WE ARE HERE ˙MOV ˙#INHD,-(SP) ˙UTM,MISC ˙BITB ˙#3,MISC+4 ˙;ANYTHING AT ALL TO DO?? ˙BEQ ˙GEND3 ˙ ˙;NO ˙JSR ˙R5,OUTLN2 ˙GL ˙ ˙ ˙;OUTPUT THE GLOBAL ˙BITB ˙BITM+0,MISC+4 ˙;DO WE NEED A READ? ˙BEQ ˙GEND2 ˙ ˙;NO ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE ˙RD ˙ ˙ ˙;$READ ˙MOVB ˙#'I,R0 ˙ ˙;GO SET UP ˙JSR ˙PC,SETIO ˙;INPUT GLOBALS ˙BITB ˙BITM+1,MISC+4 ˙BEQ ˙GEND3A ˙JSR ˙R5,OUTCH2 ˙', GEND2: ˙BITB ˙BITM+1,MISC+4 ˙;DO WE NEED A WRITE? ˙BEQ ˙GEND3 ˙ ˙;NO ˙JSR ˙R5,OUTLN2 ˙;GENERATE A WRITE ˙WT ˙MOVB ˙#'O,R0 ˙ ˙;GO SET UP ˙JV; ; 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 ˙INIT06 ; ; THIS ROUTINE IS USED TO OUTPUT COMPILER OVERLAY #6 ; ˙TO THE DISK IN IMAGE FORM ; R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ˙.CSECT ; ˙.GLOBL ˙BEG,LGT,TLB,FB0,FB1,FB2,FB3,FB4,FB5,FWCTO ; NEXJMP: ˙OV1JMP ˙;SUBROUTINE IS IN OVERLAY 1 ˙OV1JMP ˙;FUNCTION IS IN OVERLAY 1 ˙BLOCKD ˙OV1JMP ˙;EXTERNAL IS IN OVERLAY 1 ˙OV1JMP ˙;DEFINE IS IN OVERLAY 1 BJMP: ˙SCAN6 ˙ ˙;SPECIAL HANDLING FOR "TYPE" ˙OV1JMP ˙;DIMENSION IS IN OVERLAY 1 ˙COMMON ˙EQUIVA ˙OV1JMP ˙;DATA IS IN OVERLAY 1 ˙SCAN18 ˙ ˙;SPECIAL HANDLING FOR "IMPLICIT" ˙END ; ; BLOCK DATA IS EASY TO HANDLE SO IS DONE HERE ; BLOCKD: ˙TSTB ˙@R1 ˙ ˙;END OF LINE?? ˙BEQ ˙BLOCK2 ˙ ˙;YES ˙TRAP+12. ˙ ˙;NO BLOCK2: ˙INC X;NOW ˙MOV ˙#LINKK,-(SP) ˙;GET ˙READ ˙ ˙ ˙;THE USER RESPONSE ˙MOV ˙#LINKK,-(SP) ˙;AND ˙MWAIT ˙ ˙ ˙;WAIT UNTIL COMPLETE ˙CMPB ˙BUFIN,#15 ˙;IS IT A NULL LINE? ˙BEQ ˙FORT09 ˙ ˙;YES ˙MOV ˙#CMDBUF,-(SP) ˙;NOW CALL ˙CSI1 ˙ ˙ ˙;CSI PART ONE ˙MOV ˙(SP)+,R1 ˙;IS IT OK?? ˙BEQ ˙FORT01 ˙ ˙;YES ˙INC ˙R1 ˙ ˙;APPEND ˙MOVB ˙#'?,(R1)+ ˙; "?" AND ˙MOVB ˙#15,(R1)+ ˙;BLANK ˙MOVB ˙#12,(R1)+ ˙;LINE ˙MOVB ˙#12,(R1)+ ˙;TO MESSAGE ˙SUB ˙#BUFIN,R1 ˙;GET BYTE COUNT ˙MOV ˙R1,INHD+4 ˙MOV ˙#INHD,-(SPYSR ˙PC,SETIO ˙;THE OUTPUT GLOBALS GEND3A: ˙JSR ˙PC,EOL ˙ ˙;GENERATE END OF LINE AND QUIT GEND3: ˙JSR ˙R5,OUTLN2 ˙;OUTPUT END PROTOTYPE ˙ENDPR1 ˙.GLOBL ˙ROUTIN ˙TST ˙ROUTIN ˙ ˙;IS THIS THE MAIN PROGRAM? ˙BNE ˙GEND1 ˙ ˙;NO ˙TST ˙BLKDAT ˙ ˙;NO TRA ˙BNE ˙GEND1 ˙ ˙;FOR BLOCK DATA ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE TRA ADDRESS ˙ENDP1 GEND1: ˙JSR ˙PC,EOL ˙ ˙;AND AN END OF LINE ˙JMP ˙EXIT ˙ ˙;GO DO EXIT PROCESSING ; ; TSTPSH: ˙TST ˙DLAB ˙ ˙;ANY NEED FOR GENERATION?? ˙BEQ ˙GPSH2 ˙ ˙;NO ˙ADD ˙ZB6 ; INIT: ˙MOV ˙PC,SP ˙ ˙;SET UP ˙TST ˙-(SP) ˙ ˙;A STACK ˙MOV ˙LGT,R0 ˙;GET NUMBER OF BYTES TO OUTPUT ˙SUB ˙BEG,R0 ˙MOV ˙#7,R1 ˙ ˙;WE DIVIDE BY 2^7 FOR NUMBER OF BLOCKS INIT0: ˙ASR ˙R0 ˙ ˙;LOOP ˙DEC ˙R1 ˙ ˙;UNTIL DONE ˙BNE ˙INIT0 ˙ ˙; ˙INC ˙R0 ˙ ˙;ALLOCATE EXTRA BLOCK FOR ROUNDOFF ˙MOV ˙R0,-(SP) ˙;NOW ˙MOV ˙#TLB,-(SP) ˙;INIT ˙EMT ˙6 ˙ ˙;THE DISK ˙MOV ˙#FB6,-(SP) ˙; ALLOCATE ˙MOV ˙#TLB,-(SP) ˙; SOME ˙EMT ˙15 ˙ ˙; CONTIGUOUS SPACE ˙TST ˙(SP)+ ˙ ˙;DID IT WORK OK?? ˙BPL ˙INI[˙BLKDAT ˙ ˙;DISALLOW EXECUTABLES ˙MOV ˙#BLKD,R1 ˙;GET ADDRESS OF "DATA." ˙MOV ˙#MODNAM,R0 ˙.GLOBL ˙MODNAM ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLV ˙RTS ˙PC ˙ ˙;AND RETURN ; ˙.END \) ˙;AND ˙MOV ˙#LINKL,-(SP) ˙;OUTPUT THE ˙WRITE ˙ ˙ ˙;ERROR ˙BR ˙FORT09 FTERR1: ˙MOV ˙#2203,R1 ˙;TOO MANY SWITCHES ˙BR ˙FTCOM FTERR2: ˙MOV ˙#2204,R1 ˙;TOO MANY OUTPUT FILES ˙BR ˙FTCOM FTERR3: ˙MOV ˙#2205,R1 ˙;NO INPUT OR TOO MUCH INPUT FTCOM: ˙CLR ˙-(SP) ˙MOV ˙R1,-(SP) ˙IOT ˙;OUTPUT THE WORLD'S MOST USELESS DIAGNOSTIC ˙BR ˙FORT09 FORT01: ˙MOV ˙#2,CMDBUF ˙;SET FOR OUTPUT ˙MOV ˙#OBJBLK,-(SP) ˙;GET ˙CSI2 ˙ ˙ ˙;OBJECT SPECIFICATION ˙TST ˙OBJEXT ˙ ˙;DO WE USE THE DEFAULT EXTENSION?? ]R4,DPC ˙ ˙;ADVANCE DOUBLE PC ˙BMI ˙GPSH2 ˙ ˙;DON'T DO ANYTHING YET ˙MOV ˙R0,-(SP) ˙;SAVE R0 ˙TST ˙DBLT ˙ ˙;IS THIS A SPECIAL DOUBLE? ˙BEQ ˙GPSH4D ˙;NO ˙CLR ˙DBLT ˙ ˙;TURN OFF THE FLAG ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE SPECIAL GOODIES ˙PSH015 GPSH4D: ˙MOV ˙DLAB,R3 ˙;GET THE LABEL ˙MOV ˙#'F,R0 ˙ ˙;OUTPUT ˙JSR ˙PC,OUTSER ˙;ROUTINE NAME ˙JSR ˙PC,OUTCOL ˙JSR ˙R5,OUTLN2 ˙;OUTPUT THE ˙PSH009 ˙JSR ˙R5,OUTLN2 ˙; CODE PROTOTYPE ˙PSH009 ˙TST ˙RLAB ˙ ˙;CAN WE IMBED A "REAL" IN IT?? ˙BEQ ˙G^T1 ˙ ˙;NO, SCREAM IN AGONY ˙MOV ˙#FB6,-(SP) ˙;NOW FIND ˙CLR ˙-(SP) ˙ ˙; OUT WHERE ˙MOV ˙#TLB,-(SP) ˙;THE FILE ˙EMT ˙14 ˙ ˙;WAS PLACED ˙MOV ˙(SP)+,TBLK ˙;GET THE DISK ADDRESS ˙ADD ˙#4,SP ˙ ˙;DISCARD JUNK ˙MOV ˙BEG,TBLK+2 ˙;CORE ADDRESS ˙MOV ˙LGT,R2 ˙ ˙;THE ˙SUB ˙BEG,R2 ˙ASR ˙R2 ˙ ˙;WORD COUNT ˙MOV ˙R2,TBLK+4 ˙;IS SAVED TOO ˙MOV ˙#TBLK,-(SP) ˙MOV ˙#TLB,-(SP) ˙EMT ˙10 ˙ ˙;NOW TRANSFER THE DATA ˙MOV ˙#TLB,-(SP) ˙;WAIT ˙EMT ˙1 ˙ ˙;UNTIL DONE ˙EMT ˙60 ˙ ˙;AND EXIT ; INIT1: ˙C` ˙BNE ˙FORT10 ˙ ˙;NO ˙MOV ˙FORT11,OBJEXT ˙;YES FORT10: ˙MOV ˙(SP)+,R1 ˙;GET COUNT ˙BEQ ˙FORT02 ˙ ˙;GO GET LIST SPECIFICATION IF ZERO ˙CMP ˙R1,#2 ˙ ˙;OR TWO ˙BGE ˙FTERR1 ˙ ˙;TOO MANY SWITCHES ˙CLR ˙LINKSL+6 ˙;OTHERWISE NO LIST ˙BR ˙FORT05 FORT02: ˙MOV ˙#2,CMDBUF ˙MOV ˙#LSTBLK,-(SP) ˙;GET ˙CSI2 ˙ ˙ ˙;LIST SPECIFICATION ˙TST ˙LSTEXT ˙ ˙;DEFAULT EXTENSION?? ˙BNE ˙FORT13 ˙ ˙;NO ˙MOV ˙FORT12,LSTEXT ˙;YES FORT13: ˙MOV ˙(SP)+,R1 ˙BEQ ˙FTERR2 ˙ ˙;ERROR IF MORE FILES ˙CMP ˙R1,#2 ˙ ˙;TOOaPSH4B ˙ ˙;NO ˙TST ˙RLT ˙ ˙;IS IT SAFE? ˙BNE ˙GPSH4B ˙ ˙;NO, DON'T ALLOW SPECIAL CASES HERE ˙MOV ˙RLAB,R3 ˙ ˙;GENERATE ˙MOV ˙#'F,R0 ˙ ˙; A "REAL" ˙JSR ˙PC,OUTSER ˙; LABEL ˙JSR ˙PC,OUTCOL ˙;OUTPUT A COLON ˙CLR ˙RLAB ˙ ˙;RESET ˙MOV ˙#-120.,RPC ˙;REAL POINTER GPSH4B: ˙CLR ˙DLAB ˙MOV ˙#-120.,DPC GPSH4C: ˙MOV ˙(SP)+,R0 ˙;RESTORE R0 ˙JSR ˙R5,OUTLN2 ˙;GENERATE ˙PSH009 ˙ ˙ ˙; THE ˙JSR ˙R5,OUTLN2 ˙; REMAINDER ˙PSH009 ˙ ˙ ˙; OF ˙JSR ˙R5,OUTLN2 ˙; THE ˙PSH005 ˙ ˙ ˙; PROTOTYPELR ˙-(SP) ˙MOV ˙#1441,-(SP) ˙IOT ˙ ˙ ˙;DIE IN EXTREME AGONY ; TBLK: ˙0 ˙;START BLOCK ˙0 ˙;START CORE ADDRESS ˙0 ˙;WORD COUNT ˙2 ˙;WRITE ˙0 ˙;RESERVED ; ˙.END ˙INIT c; ; 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 ˙NOEX6 ˙.GLOBL ˙GETLN,SCANN,EXEC ˙.GLOBL ˙MAIN,HDR,BLKDAT,BLKD,HDRGEN ˙.GLOBL ˙SCAN2A,GETSW,SEQNO ˙.GLOBL ˙ALOCAT,LINE,END003,END,SYN2ER ˙.GLOBL ˙ASF,EXECUT ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= d MANY ITEMS?? ˙BGE ˙FTERR1 ˙ ˙;YES FORT05: ˙CLR ˙CMDBUF ˙;LOOK ˙MOV ˙#INPBLK,-(SP) ˙;GET ˙CSI2 ˙ ˙ ˙;INPUT SPECIFICATION ˙TST ˙LINKI+6 ˙ ˙;INPUT SPECIFIED?? ˙BEQ ˙FTERR3 ˙ ˙;NO ˙TST ˙SRCEXT ˙ ˙;EXTENSION SPECIFIED?? ˙BNE ˙FORT03 ˙ ˙;YES ˙MOV ˙FORT14,SRCEXT ˙;SPECIFY DEFAULT /FTN/ ˙MOV ˙#FORT04,SRCERR ˙;SET ERROR RETURN FORT03: ˙MOV ˙(SP)+,R1 ˙;ERROR IF ˙BEQ ˙FTERR3 ˙ ˙;ZERO ˙CMP ˙R1,#2 ˙BGE ˙FTERR3 ˙MOV ˙#LINKL,-(SP) ˙;RELEASE ˙RLS ˙ ˙ ˙;TELEPRINTER ˙MOV ˙#LINKK,-(SP) ˙RLe ˙MOV ˙#7,R4 ˙TST ˙RLT ˙ ˙;SHALL WE CHECK REAL? ˙BNE ˙GPSH2 ˙ ˙;YES GPSH4A: ˙RTS ˙PC ; ; GPSH2: ˙TST ˙RLAB ˙ ˙;ANYTHING TO DO?? ˙BEQ ˙GPSH4A ˙ ˙;NO ˙ADD ˙R4,RPC ˙ ˙;ADVANCE REAL PC ˙BMI ˙GPSH4A ˙ ˙;NOTHING TO DO YET ˙MOV ˙R0,-(SP) ˙;SAVE R0 ˙TST ˙RLT ˙ ˙;CHECK FOR SPECIAL REAL ˙BEQ ˙GPSH2A ˙ ˙;NOT SPECIAL ˙CLR ˙RLT ˙JSR ˙R5,OUTLN2 ˙PSH016 GPSH2A: ˙MOV ˙RLAB,R3 ˙MOV ˙#'F,R0 ˙ ˙;GENERATE ˙JSR ˙PC,OUTSER ˙; THE LABEL ˙JSR ˙PC,OUTCOL ˙;FOLLOWED BY A COLON ˙CLR ˙RLAB ˙MOVf; ; 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 ˙HEAD04 ˙.GLOBL ˙ELOC,EXECU,OVJMP,BEG,LGT ˙.CSECT ;OVERLAY 4 HEADER ;WARNING-HEAD03, HEAD04, HEAD05 MUST BE THE SAME LENGTH BEG: ˙. ˙;0 LGT: ˙ELOC ˙;2 ˙EXECU ˙;4 ˙OVJMP ˙;6 ˙0 ˙;FILLER ˙0 ˙;12-FILLER ˙.END g˙%6 PC ˙= ˙%7 ; SPACE ˙= ˙40 ; ; SCANNR IS THE MAIN CONTROL LOOP FOR THE COMPILER. IT CALLS ; ˙GETLN FOR A LINE OF TEXT AND THEN DISPATCHES TO ; ˙THE PROPER STATEMENT HANDLER. ; ; ˙EACH STATEMENT HANDLER IS DISPATCHED TO BY A "JSRPC,XXX". ; ˙UPON ENTRY TO THE HANDLER, R1 POINTS TO THE CHARACTER ; ˙WHERE THE RECOGNITION SCAN LEFT OFF. ; ; ˙EACH HANDLER IS, IN GENERAL, RESPONSIBLE FOR COMPLETE ; ˙PROCESSING OF THE REMAINDER OF THE LINE, UP TO AND ; ˙INCLUDING THE TERMINATOR BYTE. ; ; ˙RETUhS ˙ ˙ ˙;RELEASE THE KEYBOARD ˙MOV ˙#LINKI,-(SP) ˙;INITIALIZE ˙INIT ˙ ˙ ˙; INPUT ˙TST ˙LINKSL+6 ˙;IS THERE A SOURCE LISTING???? ˙BEQ ˙FORT06 ˙;NO ˙MOV ˙#LINKSL,-(SP) ˙;INITIALIZE ˙INIT ˙ ˙ ˙; SOURCE LIST ˙MOV ˙#LSTDEL,LSTER LSTD1: ˙MOV ˙˙#SRCLS,-(SP) ˙;ADDRESS OF SOURCE LIST FNB ˙MOV ˙#LINKSL,-(SP) ˙;ADDRESS OF LB ˙OPEN ˙ ˙ ˙;OPEN SOURCE LIST ˙CLR ˙LSTER FORT06: ˙TST ˙LINKOL+6 ˙;IS THERE ANY OBJECT OUTPUT?? ˙BEQ ˙FORT07 ˙MOV ˙#LINKOL,-(SP) ˙;INITIALIZE ˙INIT ˙ ˙ ˙; OBJECT OUTPUTi ˙#-120.,RPC ˙;RESET POINTER ˙BR ˙GPSH4C ˙ ˙;GO TO FINISH UP ; DBLT: ˙0 RLT: ˙0 ; PSHP: ˙JSR ˙R5,OUTCH2 ˙;OUTPUT AN INDIRECT ˙'@ PSHP1: ˙MOVB ˙PARXWD(R0),R3 ˙;GET THE INDEX ˙BIC ˙#177400,R3 ˙;OUTPUT ˙JSR ˙PC,OUTOCT ˙; THE INDEX ˙JSR ˙R5,OUTLN2 ˙;NOW PUT OUT TNE REST OF THE ˙PSH010 ˙ ˙ ˙;JUNK ˙RTS ˙PC SETIO: ˙MOV ˙#BITM+2,R1 ˙;SET UP ˙MOV ˙#MISC+4,R2 ˙;FOR WHIRLWIND CHECK OF GLOBALS ˙BITB ˙(R1)+,@R2 ˙;DO WE NEED A DOUBLE CONVERSION? ˙BEQ ˙SETIO2 ˙ ˙;NO ˙JSR ˙R5,OUTLN2 ˙;GENERATkRN FROM THE HANDLER IS AS FOLLOWS: A NORMAL ; ˙RETURN WILL RETURN USING A "RTS PC" WITH THE V-BIT ; ˙OF THE STATUS WORD CLEAR. A RETURN WITH THE V-BIT ; ˙SET MAY ONLY OCCUR IF THE LINE IN QUESTION COULD ; ˙NOT BE OF THE ASSUMED TYPE. ; ; ˙ ˙EXAMPLE: COMMON=1 IS A LEGAL STATEMENT, BUT ; ˙ ˙THE COMMON PROCESSOR WOULD FIND IT ; ˙ ˙UNRECOGNIZABLE SO THE PROCESSOR WOULD SET THE ; ˙ ˙V-BIT BEFORE RETURNING. ; ; ˙THE IMPLICIT AND TYPE PROCESSORS ARE ENTERED ; ˙AS ABOVE EXCEPT THAT R0 CONTAIS THE Ml ˙MOV ˙#OBJDEL,OBJER OBJD1: ˙MOV ˙#OBJLS,-(SP) ˙;OBJECT OUTPUT FNB ˙MOV ˙#LINKOL,-(SP) ˙; LB ˙OPEN ˙ ˙ ˙;OPEN OBJECT OUTPUT ˙CLR ˙OBJER FORT07: ˙MOV ˙#SRCIN,-(SP) ˙;ADDRESS OF INPUT FNB ˙MOV ˙#LINKI,-(SP) ˙;ADDRESS OF LINK BLOCK ˙OPEN ˙ ˙ ˙;OPEN SOURCE INPUT ˙MOV ˙#STCLR,R0 ˙;NOW FORT08: ˙CLR ˙(R0)+ ˙ ˙;CLEAR THE ˙CMP ˙R0,#ENDCLR ˙;TABLE ˙BLT ˙FORT08 ˙ ˙;LIST ˙MOV ˙HIGH,R5 ˙ ˙;GET HIGHEST LOC. IN COMPILER ˙TST ˙(R5)+ ˙ ˙;PLUS TWO! ˙MOV ˙R5,SYMBAS ˙;THIS IS WHERE THE TABLE STARTSmE THE DOUBLE CONV. ˙DC ˙MOV ˙R0,R4 ˙ ˙;SET THE ˙JSR ˙PC,OUTCHR ˙;I/O TYPE TOO ˙BITB ˙(R1)+,@R2 ˙;DO WE NEED INTEGER? ˙BEQ ˙SETIO5 ˙ ˙;NO ˙JSR ˙R5,OUTCH2 ˙', SETIO3: ˙JSR ˙R5,OUTLN2 ˙;OUTPUT INTEGER CONVERSION ˙IC ˙MOV ˙R0,R4 ˙ ˙;SET THE ˙JSR ˙PC,OUTCHR ˙ ˙;I/O TYPE ˙BITB ˙(R1)+,@R2 ˙;DO WE NEED LOGICAL? ˙BEQ ˙SETIO1 ˙ ˙;NO ˙JSR ˙R5,OUTCH2 ˙;OUTPUT A COMMA TOO ˙', SETIO4: ˙JSR ˙R5,OUTLN2 ˙;OUTPUT LOGICAL ˙LC ˙MOV ˙R0,R4 ˙ ˙;AND ITS ˙JSR ˙PC,OUTCHR ˙; TERMINATOR SETIO1: n; ; 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 ˙ER2027 ; ; FORTRAN SYNTAX ERROR PROCESSOR - ; ˙.GLOBL ˙SYN3ER,DBUF,LINE,CODE ˙.GLOBL ˙DIAG,LINKSL,LINKOL ˙.GLOBL ˙DBUF,OUTPUT,ECNT ˙.GLOBL ˙SYNFER,ERRCUR,ERRS,ERREND ˙.CSECT ; R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5oODE OF ; ˙THE IMPLICIT OR TYPE STATEMENT ; ˙REGISTERS CHANGED - ALL. ; EXSTM: ˙JSR ˙PC,CKMAIN ˙;DO A HEADING JUST IN CASE ˙JMP ˙EXECUT ˙ ˙;GO DO THE EXECUTABLES END00: ˙TRAP+39. ˙ ˙;MISSING END STATEMENT ˙JSR ˙PC,END003 ˙;LINKAGE TO END HANDLER SCANN: ˙CLRB ˙GETSW ˙ ˙;NO, CLEAR GET SWITCH JUST IN CASE SCANR: ˙JSR ˙PC,SYN2ER ˙;PRINT ANY DIAGNOSTICS WHICH ˙ ˙ ˙ ˙;OCCURRED, THIS STATEMENT ˙.GLOBL ˙SYN2ER ˙INC ˙SEQNO ˙ ˙;ADVANCE SEQUENCE NUMBER ˙JSR ˙PC,GETLN ˙;GET A LINE OF TEXT ˙BVS ˙ENp ˙MOV ˙SIZE,SYMEND ˙;GET END ˙SUB ˙#350,SYMEND ˙; OF SYMBOL TABLE ˙TST ˙(R5)+ ˙MOV ˙R5,SYMCUR ˙;SET START OF FREE SPACE ˙INC ˙SERIAL ˙ ˙;SET SERIAL START TO ONE ˙INC ˙FLABL ˙ ˙;PRESET INTERNAL LABEL POINTER ˙CLR ˙ALOKAT ˙CLR ˙COMCLR ˙CLR ˙COMUN ˙CLR ˙EQVHED ˙TST ˙-(SP) ˙MOV ˙SP,COMHGH ˙;ALLOCATE THE COMMON ˙SUB ˙#400,SP ˙ ˙;TABLE ˙MOV ˙SP,COMLOW ˙;AREA ˙MOV ˙SP,COMNXT ˙;HERE ˙MOV ˙#IMPTAB,R0 ˙;GET READY TO SET UP IMPLICIT IMPLP: ˙MOVB ˙#030,(R0)+ ˙;PRESTORE TYPE "REAL" ˙q˙RTS ˙PC SETIO2: ˙BITB ˙(R1)+,@R2 ˙;CHECK INTEGER ˙BNE ˙SETIO3 SETIO5: ˙BITB ˙(R1)+,@R2 ˙;CHECK LOGICAL ˙BNE ˙SETIO4 ˙RTS ˙PC ; GL: ˙.ASCII ˙/ ˙.GLOBL ˙/ ˙.BYTE ˙0 RD: ˙.ASCII ˙/$READ,/ ˙.BYTE ˙0 WT: ˙.ASCII ˙/$WRITE,/ ˙.BYTE ˙0 DC: ˙.ASCII ˙/$DC/ ˙.BYTE ˙0 IC: ˙.ASCII ˙/$IC/ ˙.BYTE ˙0 LC: ˙.ASCII ˙/$LC/ ˙.BYTE ˙0 ; ENDPR1: ˙.ASCII ˙/ ˙.END/ ˙.BYTE ˙0 ENDP1: ˙.ASCII ˙/ ˙MAIN./ ˙.BYTE ˙0 ENDP2: ˙.ASCII ˙/ ˙.GLOBL ˙$EXIT/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$EXIT ˙.BYTE ˙15,12r ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ; ; THIS PROCESSOR OUTPUTS SOURCE LANGUAGE DIAGNOSTICS ; ˙TO THE OUTPUT SOURCE AND OBJECT DEVICES. ;ENTERED ONCE PER STATEMENT, AFTER IT IS PROCESSED. ;OUTPUTS DIAGNOSTICS AS PER ENTRIES IN THE ;DIAGNOSTIC TABLE ; ; ˙INSTRUCTION WITH ALL CONDITIONS AND REGISTERS AS BEFORE ; ; ˙REGISTERS CHANGED - NONE. ; SYN3ER: ˙CMP ˙ERRCUR,#ERRS ˙;ANY ERRORS? ˙BNE ˙SYN2S ˙ ˙;YES ˙RTS ˙PC ˙ ˙;NO SYN2S: ˙MOV ˙R0,-(SP) ˙MOV ˙R1,-(SP) ˙;SAVE ALL ˙MOV ˙R2,-(SP) ˙; REGISTEsD00 ˙ ˙;ASSUME END IF EOF OR EOM ˙TST ˙BLKDAT ˙ ˙;IS THIS ROUTINE ONLY BLOCK DATA?? ˙BEQ ˙SCAN1 ˙ ˙;NO ; SCAN2: ˙MOV ˙#BDATA,R0 ˙;PROTOTYPES ALLOWED IN BLOCK DATA ˙BR ˙SCAN3 SCAN1: ˙MOV ˙#NEXTBL,R0 ˙;NON-EXECUTABLE PROTOTYPES SCAN3: ˙JSR ˙PC,SCAN2A ˙;GO SEARCH FOR VERB ˙BVS ˙SCAN12 ˙ ˙;NOT FOUND ˙TST ˙BLKDAT ˙ ˙;IS THIS BLOCK DATA?? ˙BNE ˙SCAN5 ˙ ˙;JUMP IF YES ˙CMP ˙R0,#NXTBL1-NEXTBL ˙;SEE IF TYPE DECL. ˙BGE ˙SCAN7 ˙ ˙;IT GETS SPECIAL HANDLING ˙JSR ˙PC,CKMAIN ˙;GO SEE IF MAIN PROGRAMtCMP ˙R0,#IMPTAB+26. ˙;ALL 26 LETTERS ˙BLO ˙IMPLP ˙ ˙;ARE DONE ˙MOV ˙#IMPTAB+8.,R0 ˙;POINT TO INTEGERS IMPLP2: ˙MOVB ˙#020,(R0)+ ˙;PRESTORE "INTEGER" ˙CMP ˙R0,#IMPTAB+14. ˙;IN 6 OF THEM ˙BLO ˙IMPLP2 ˙ ˙;NOW WE HAVE A FRESH TABLE ˙MOV ˙#ERRS,ERRCUR ˙;INITIALIZE ERROR TABLE ˙JMP ˙SCANNR ˙ ˙;GO DO SOME FORTRAN ;THE DEFAULT EXTENSION ON INPUT WAS NOT THERE FORT04: ˙CLR ˙SRCERR ˙ ˙;TURN OFF ERROR RETURN ˙CLR ˙SRCEXT ˙ ˙;SET NULL EXTENSION ˙BR ˙FORT07 ˙ ˙;GO TRY TO FIND IT LSTDEL: ˙CLR ˙LSTERu,0 PSH001: ˙.BYTE ˙': PSH002: ˙.ASCII ˙/ ˙MOV ˙/ EL: ˙.BYTE ˙0 PSH003: ˙.ASCII ˙/ ˙MOV ˙-(%0)/ PSH004: ˙.ASCII ˙/,-(%6)/ ˙.BYTE ˙15,12,0 PSH005: ˙.ASCII ˙/ ˙JMP ˙@(%4)+/ ˙.BYTE ˙15,12,0 PSH007: ˙.ASCII ˙/+10,%0/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙BR ˙/ ˙.BYTE ˙0 PSH008: ˙.ASCII ˙/+4,%0/ PSH017: ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙BR ˙/ ˙.BYTE ˙0 PSH009: ˙.ASCII ˙/ ˙MOV ˙-(%0),-(%6)/ ˙.BYTE ˙15,12,0 PSH010: ˙.ASCII ˙/(%5)/ ˙.BYTE ˙0 PSH011: ˙.ASCII ˙/-4/ ˙.BYTE ˙0 PSH012: ˙.ASCII ˙/,%0/ ˙.BvRS ˙MOV ˙R3,-(SP) ˙; SO I CAN ˙MOV ˙R4,-(SP) ˙; USE I/O HANDLERS WITHOUT ˙MOV ˙R5,-(SP) ˙; DISTURBING COMPILATION ; ;INIT AND OPEN THE DIAGNOSTIC FILE ; ˙MOV ˙#5015,DBUF ˙;THIS IS A PACKED ˙MOV ˙#2,R5 ˙;COUNT IS TWO ˙JSR ˙˙PC,OUTDGN ˙;OUTPUT A BLANK LINE ˙CLR ˙DIFEX ˙ ˙;SET DIFEX TO "EXISTS" ˙MOV ˙#DILINK,-(SP) ˙;INIT ˙EMT ˙6 ˙MOV ˙#DIFILE,-(SP) ˙;OPEN ˙MOV ˙#DILINK,-(SP) ˙EMT ˙16 ; ;INITIALIZE POINTER TO ERROR TABLE SYN106: ˙MOV ˙#ERRS,DIPTR ; IF DIAG FILE Nw HEADER NEEDED ˙JSR ˙PC,@NEXJMP(R0) ˙;JUMP TO NON-EXECUTABLES SCAN13: ˙BVC ˙SCANN ˙BR ˙SCAN14 ˙.GLOBL ˙OVJMP OVJMP: ˙JMP ˙@NEXJMP(R0) ˙;THIS ALLOWS OTHER OVERLAYS ˙ ˙ ˙ ˙;TO USE THE TABLES IN HERE SCAN5: ˙CMP ˙R0,#NXTBL1-BDATA ˙;CHECK FOR TYPE DECLARATION ˙BGE ˙SCAN20 ˙ ˙;JUMP IF IT IS ˙ADD ˙#BJMP-NEXJMP,R0 ˙;FUDGE THE POINTER ˙JSR ˙PC,@NEXJMP(R0) ˙;GO PROCESS STATEMENT ˙BVC ˙SCANR ˙ ˙;RETURN TO LOOP ˙BR ˙SCAN15 ˙ ˙;OR GIVE ERROR SCAN20: ˙SUB ˙#NXTBL1-BDATA,R0 ;FUDGE THE MODE POINTERx ˙MOV ˙#SRCLS,-(SP) ˙;DELETE ˙MOV ˙#LINKSL,-(SP) ˙;THE ˙DEL ˙ ˙ ˙;FILE ˙BR ˙LSTD1 OBJDEL: ˙CLR ˙OBJER ˙ ˙;DELETE ˙MOV ˙#OBJLS,-(SP) ˙;THE ˙MOV ˙#LINKOL,-(SP) ˙;OBJECT ˙DEL ˙ ˙ ˙;FILE ˙BR ˙OBJD1 EXIT: ˙MOV ˙#LINKI,-(SP) ˙;CLOSE ˙CLOSE ˙ ˙ ˙;EVERYTHING ˙MOV ˙#LINKI,-(SP) ˙;RELEASE ˙RLS ˙ ˙ ˙;INPUT ˙TST ˙LINKSL+6 ˙BEQ ˙END001 ˙MOV ˙#LINKSL,-(SP) ˙;QUICKLY ˙CLOSE ˙ ˙ ˙;AND ˙MOV ˙#LINKSL,-(SP) ˙;RELEASE ˙RLS ˙ ˙ ˙;SOURCE LIST END001: ˙TST ˙LINKOL+6 ˙BEQ ˙END002 ˙MOV ˙#LyYTE ˙0 PSH015: ˙.ASCII ˙/ ˙ADD ˙#10,%0/ ˙.BYTE ˙15,12,0 PSH016: ˙.ASCII ˙/ ˙ADD ˙#4,%0/ ˙.BYTE ˙15,12,0 GENP4: ˙.ASCII ˙/. ˙= ˙.+/ ˙.BYTE ˙0 GENP1: ˙.ASCII ˙/: ˙0/ ˙.BYTE ˙15,12,0 GENP2: ˙.ASCII ˙/: ˙0,0/ ˙.BYTE ˙15,12,0 GENP3: ˙.ASCII ˙/: ˙0,0,0,0/ ˙.BYTE ˙15,12,0 ˙.EVEN ˙.END zOT PRESENT, SKIP "GET" ˙TST ˙DIFEX ˙BNE ˙SYN105 ;GET BUFFER SIZE ˙MOV ˙#1,DIBLOK ˙;SET FUNCTION BIT FOR "GET" ˙MOV ˙#DIBLOK,-(SP) ˙MOV ˙#DILINK,-(SP) ˙EMT ˙11 ˙ ˙;BLOCK TRANSFER: GET. ;DIVIDE 64 INTO BLOCK SIZE TO DETERMINE THE # OF MESSAGES ;PER BLOCK. ˙MOV ˙DILEN,R5 ˙;GET BLOCK SIZE ˙ASL ˙R5 ˙ ˙;CONVERT WORD SIZE TO BYTE SIZE ˙MOV ˙#64.,R4 ˙CLR ˙R3 SYN100: ˙INC ˙R3 ˙CMP ˙R4,R5 ˙ ˙;EQUAL? ˙BEQ ˙SYN102 ˙ ˙;BR IF DIVISION IS DONE ˙ASR ˙R5 ˙ ˙;ELSE DIVIDE BLOCK SIZE BY 2 ˙BR { ˙BR ˙SCAN21 ˙ ˙;ASSUME "TYPE" SCAN12: ˙JSR ˙PC,CKMAIN ˙;SEE IF HEADER NEEDED SCAN14: ˙TST ˙BLKDAT ˙ ˙;CHECK FOR BLOCK DATA ˙BNE ˙SCAN15 ˙ ˙;DON'T CHECK ASF IF BLOCK DATA ˙JSR ˙PC,ASF ˙ ˙;GO TRY FOR ASF ˙BVS ˙EXSTM ˙ ˙;WASN'T ARITH. STMT. FNCT. ˙BR ˙SCANN ˙ ˙;GO BACK FOR A LINE SCAN15: ˙TRAP+4 ˙ ˙ ˙;BAD STATEMENT IN BLOCK DATA ˙BR ˙SCANR ; ; CKMAIN - SUBROUTINE TO CHECK FOR THE NEED OF A MAIN PROGRAM HEADER. ; ˙IF ONE IS NEEDED, THE HEADER GENERATOR IS CALLED WITH ; ˙THE NAME "MAIN." ;|INKOL,-(SP) ˙;QUIT ˙CLOSE ˙MOV ˙#LINKOL,-(SP) ˙;RELEASE OBJECT LIST ˙RLS END002: ˙MOV ˙#LINKK,-(SP) ˙INIT ˙ ˙;RE-INIT TTY ˙MOV ˙#LINKL,-(SP) ˙INIT ; OUTPUT THE ERROR COUNT IF ANY ˙MOV ˙ECNT,R4 ˙ ˙;GET ERROR COUNT ˙BEQ ˙FORT9A ˙ ˙;EXIT IF NONE ˙CLR ˙ECNT ˙ ˙;CLEAR COUNT ˙MOVB ˙#' ,R2 ˙CMP ˙R4,#1 ˙ ˙;ONLY ONE ERROR?? ˙BEQ ˙FORT9B ˙ ˙;YES ˙MOVB ˙#'S,R2 ˙ ˙;MORE THAN ONE FORT9B: ˙MOVB ˙R2,ERR1 ˙MOV ˙#ERR,R3 ˙ ˙;GET ADDRESS OF ˙JSR ˙PC,ITOA ˙ ˙;DESTINATION AND CONVERT TO ASCII ~˙SYN100 SYN102: ˙MOV ˙R3,DIFACT ˙;UNLOAD QUOTIENT SYN105: ˙MOV ˙@DIPTR,R1 ˙;PICK UP 1ST VALUE OF R1 ˙ADD ˙#2,DIPTR ˙SUB ˙#8.,R1 ˙ ˙;BACK UP CHARACTER POINTER ˙CMP ˙R1,#LINE ˙;DID I BACK UP TOO FAR?? ˙BGE ˙SYN001 ˙ ˙;NO ˙MOV ˙#LINE,R1 ˙;YES, RESET POINTER SYN001: ˙MOV ˙#CHARS,R0 ˙;GET ADDRESS OF SUBSTITUTION CHARS. ˙MOV ˙#DBUF,R2 ˙;GET ADDRESS OF ERROR BUFFER ˙MOVB ˙(R0)+,(R2)+ ˙;TRANSFER "<" ˙MOV ˙#11.,R3 ˙ ˙;GET COUNT SYN002: ˙DEC ˙R3 ˙ ˙;DECREMENT COUNT ˙BEQ ˙SYN004 ˙ ˙;EXIT WHEN D ˙REGISTERS CHANGED - R4,R5. ; CKMAIN: ˙CMP ˙R0,#HDRN-NEXTBL ;IS THIS SUBROUTINE OR FUNCTION? ˙BLE ˙CK1 ˙ ˙;YES CKM1: ˙TST ˙HDR ˙ ˙;IS HEADER ALREADY DONE? ˙BNE ˙CK1 ˙ ˙;EXIT IF DONE ˙MOV ˙R0,-(SP) ˙;SAVE STATEMENT TYPE ˙MOV ˙R1,-(SP) ˙MOV ˙#MAIN,R1 ˙;GET ADDRESS OF "MAIN." ˙MOV ˙#MODNAM,R0 ˙.GLOBL ˙PACK00 ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLR ˙ROUTIN ˙.GLOBL ˙ROUTIN ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R0 ˙;RESTORE STATEMENT TYPE CK1: ˙RTS ˙PC ˙€ ˙MOV ˙#ENDERR,R5 ˙;GET COUNT, ˙MOV ˙#ERR,GBUF+6 ˙;BUFFER ADDRESS, ˙MOV ˙#DESC,R4 ˙;AND I/O DESCRIPTOR ˙JSR ˙PC,OUTPUT ˙;GIVE USER THE BAD NEWS FORT9A: ˙JMP ˙FORT09 ˙;AND TRY IT ALL AGAIN DESC: ˙GBUF ˙LINKL TITLE: ˙.BYTE ˙'#,13 TEND ˙=.-TITLE ˙.EVEN ERR: ˙.ASCII ˙/0000 ERROR/ ERR1: ˙.ASCII ˙/S/ ˙.BYTE ˙15,12 ENDERR ˙= ˙.-ERR ˙.EVEN FORT11: ˙.RAD50 ˙/PAL/ FORT12: ˙.RAD50 ˙/LST/ FORT14: ˙.RAD50 ˙/FTN/ ˙.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 ˙SUBFUN ˙.GLOBL ˙FUNCTI,FUNC,SUBROU,ROUTIN,PARCNT,HDR,GET ˙.GLOBL ˙NAMSER,CURSYM,SYM1WD,HDRGEN,NAMMKM,NAMWD ˙.GLOBL ˙PARCNT,DATYMM,DATYWD,SGLMKM,SGLWD,SYMSER ˙.GLOBL ˙NXTCH,PARMKM,PARWD,PARXWD,ENTYMM,ENTYWD ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2‚ONE ˙MOVB ˙(R1)+,R4 ˙;GET A CHARACTER ˙BEQ ˙SYN004 ˙ ˙;EXIT IF END OF LINE ˙CMP ˙R4,#40 ˙ ˙;IS ITCONTROL CHARACTER?? ˙BGE ˙SYN003 ˙ ˙;NO, GO TRANSFER IT ˙MOVB ˙#'^,(R2)+ ˙;YES, TRANSFER "^" ˙ADD ˙#100,R4 ˙ ˙;CONVERT TO CHARATER SYN003: ˙MOVB ˙R4,(R2)+ ˙BR ˙SYN002 ˙ ˙;GO FOR 10 IF POSSIBLE SYN004: ˙MOVB ˙(R0)+,(R2)+ ˙;TRANSMIT ˙BNE ˙SYN004 ˙ ˙;EMAINDER OF PERMANENT MESSAGE ˙DEC ˙R2 ˙SUB ˙#DBUF,R2 ˙;GET CH. COUNT + 1 ˙MOV ˙R2,R5 ˙ ˙;SET UP COUNT ˙JSR ˙PC,OUTDGN ˙MOV ˙#DBUF,R2 ƒ ˙;AND RETURN ; ; THIS CODE HANDLES QUICKLY FUNCTION CALLS WITH EXPLICIT ; ˙TYPING. ; SCAN7: ˙SUB ˙#NXTBL1-NEXTBL,R0 ˙;FUDGE THE MODE POINTER ˙MOV ˙R0,-(SP) ˙;SAVE TYPE FLAG FOR LATER USE ˙MOV ˙#FNTBL,R0 ˙;CHECK FOR "FUNCTION". ˙JSR ˙PC,SCAN2A ˙;GO SEE IF PRESENT ˙BVC ˙SCAN9 ˙ ˙;IT WAS THERE ˙MOV ˙(SP)+,R0 ˙;IT WASN'T, SO IT IS "TYPE". SCAN21: ˙MOV ˙#TYPE,-(SP) ˙;SET ROUTINE ADDRESS ˙JSR ˙PC,CKM1 ˙ ˙;SET UP HEADER IF NEEDED ˙BR ˙SCAN8 ˙ ˙;GO PROCESS TYPE. SCAN9: ˙MOV ˙(SP)+,R0 ˙;GET T… ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; TAB ˙= ˙11 ; SUBROUTINE HANDLING ; SUBERR: ˙TRAP+89. ˙ ˙;ILLEGAL ROUTINE NAME ˙RTS ˙PC SUBROU: ˙MOV ˙#1,ROUTIN ˙;SET THE SUBROUTINE FLAG ˙CLR ˙PARCNT ˙;CLEAR THE PARAMETER COUNT SUB01: ˙TST ˙HDR ˙ ˙;IS THERE ALREADY A HEADER?? ˙BNE ˙BDSUB1 ˙ ˙;YES ˙JSR ˙PC,GET ˙;GET THE NAME ˙BVS ˙SUBERR ˙MOV ˙R0,NAMSER ˙MOV ˙CURSYM,R0 ˙ADD ˙#SYM1WD,R0 ˙MOV ˙R3,-(SP) ˙JSR ˙PC,HDRGEN ˙MOV ˙(SP)+,R3 ˙MOV ˙CURSYM,R0 ˙TST ˙R3 ˙ ˙†˙;GET BUFFER ADDRESS SYN04A: ˙MOVB ˙(R0)+,(R2)+ ˙;STORE THE ˙BNE ˙SYN04A ˙ ˙;WORD "ERROR" ˙DEC ˙R2 ;CONVERT ERR. # TO DECIMAL ASCII, PUT INTO DBUF FOR OUTPUT ˙MOV ˙@DIPTR,-(SP) ˙MOV ˙R2,-(SP) ˙MOV ˙R2,R5 ˙MOV ˙#3,-(SP) ˙EMT ˙42 SYN101: ˙CMPB ˙@R5,#'0 ˙ ˙;GET RID ˙BNE ˙SYN103 ˙ ˙;OF THE ˙MOVB ˙#' ,(R5)+ ˙;LEADING ˙BR ˙SYN101 ˙ ˙;ZEROS SYN103: ˙MOVB ˙(R0)+,DBUF+12 ˙MOVB ˙(R0)+,DBUF+13 ˙MOV ˙#14,R5 ˙;# CHARS TO OUTPUT ˙JSR ˙PC,OUTDGN ˙;WRITE TO LIST AND OBJ DEV ˙INC ˙ECNT ˙;IN‡YPE OF FUNCTION CALL ˙ASR ˙R0 ˙ ˙;GET THE ˙MOVB ˙MODE(R0),R0 ˙; SELECTED MODE ˙JSR ˙PC,FUNCTO ˙ ˙;AND GO TO SPECIAL FUNCTION ENTRY ˙BR ˙SCAN13 ; ; IMPLICIT PROCESSING OCCURS HERE ; SCAN18: ˙MOV ˙#IMPLIC,-(SP) ˙BR ˙SCAN17 ; ; TYPE PROCESSING HAPPENS NICELY HERE ; SCAN6: ˙MOV ˙#TYPE,-(SP) ˙;GET TYPE DISPATCH ADDRESS SCAN17: ˙MOV ˙#NXTBL1,R0 ˙;GET ADDRESS OF TYPE LIST ˙JSR ˙PC,SCAN2A ˙;GET THE TYPE DECLARATION ˙BVS ˙SCAN11 ˙ ˙;ILLEGAL TYPE STATEMENT SCAN8: ˙ASR ˙R0 ˙ ˙;GET BYTE INDEX ˆ; ; 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 ˙SYM048 ;FORTRAN SYMBOL TABLE HANDLING ROUTINES ˙.CSECT .GLOBL ˙DDDD,IIII,LSTCHN,MOD40,RRRR,GETN .GLOBL ˙NAMMK,NAMMKM,NAMWD,SCAN2A,SERIAL .GLOBL ˙COMNWD,NOCNSV,ALLOWD,ALLMK,ALLMKM .GLOBL ˙GET,SERATR,LOW,SCANNR,LOGREL .GLOBL ˙PUTSYM,GETSYM,MOV‰;CHECK MODE, IS IT CORRECT? ˙BNE ˙BADSUB ˙ ˙;NO ˙BIS ˙#NAMMKM,NAMWD(R0) ; SET NAME FLAG ˙TST ˙PARCNT ˙ ˙;IS THIS A SPECIAL FUNCTION CALL? ˙BPL ˙SUB02 ˙ ˙;NO ˙BIC ˙#DATYMM,DATYWD(R0) ;CLEAR THE TYPE FIELD ˙MOVB ˙PARCNT,R2 ˙;GET THE ˙SWAB ˙R2 ˙ ˙;NEW ˙ASL ˙R2 ˙ ˙;TYPE ˙ASL ˙R2 ˙ ˙;INTO PLACE ˙ASL ˙R2 ˙ ˙;AND ˙BIS ˙R2,DATYWD(R0) ˙;PLACE IT IN THE TABLE ENTRY SUB02: ˙BIC ˙#SGLMKM,SGLWD(R0) ;CLEAR SINGLE OCCURRENCE ˙MOV ˙#SYMSER,R2 ˙MOV ˙#7,R3 SUB03: ˙MOV ˙(R0)+,(R2)+ ˙;SET UP ˙DEŠCREMENT GLOBAL ERROR COUNTER ; IF DIAG FILE NOT PRESENT, DON'T TRY TO PRINT ; ˙MESSAGE ˙TST ˙DIFEX ˙BEQ ˙SYN107 ˙ADD ˙#2,DIPTR ˙BR ˙SYN108 SYN15A: ˙BR ˙SYN105 ;GET BLOCK # FROM ERROR# SYN107: ˙CLR ˙R3 ˙MOV ˙@DIPTR,R5 ˙;ERROR NUMBER # ˙MOV ˙DIFACT,R4 ˙;BLOCK SIZE/64 = BLOCKING FACTOR SYN201: ˙INC ˙R3 ˙SUB ˙R4,R5 ˙ ˙;THIS COMPUTES ˙BLE ˙SYN200 ˙ ˙; (ERROR #/BLOCKING FACTOR)-1 ˙BR ˙SYN201 ;REMAINDER MINUS DIVSOR, OR 0, IS IN R5 SYN200: ˙TST ˙R5 ˙;IF REMAINDER IS 0 DONT ˙BEQ ˙SYN‹INTO MODE TABLE ˙MOVB ˙MODE(R0),R0 ˙;GET MODE IN R0 ; ; THE FOLLOWING LINES ARE TEMPORARY AND ARE USED ONLY TO WARN ; ˙THE USER THAT THE COMPILER CAN HANDLE COMPLEX, BUT ; ˙THAT THE OBJECT TIME SYSTEM HAS NO PROVISIONS FOR ; ˙HANDLING COMPLEX. ; ; ˙WHEN THE OTS COMPLEX ROUTINES ARE COMPLETED, THE FOLLOWING ; ˙THREE LINES SHOULD BE DELETED. ; ˙CMPB ˙R0,#5 ˙ ˙;IS IT COMPLEX HE WANTS? ˙BNE ˙SCAN8A ˙ ˙;NO, LET IT PASS ˙TRAP+87. ˙ ˙;WARN HIM THAT IT IS A FUTURE ˙ ˙ ˙ ˙; FEATURE ; THIS IS THŒE,HIGH .GLOBL ˙GETID,CHTEST,FILL,IMPTAB,PACK00 .GLOBL ˙CURSYM,GETSW,NXTCH,SYMCUR,CONINT .GLOBL ˙OTOA,SYMEND,SYMCUR,SYMNXT,CNXC1 .GLOBL ˙ENTYWD,SIZE,CNXC,ENTYMM,ENTYMK,DATYWD,DATYMK,DATYMM .GLOBL ˙DIMWD,DIMMK,DIMMKM,CONWD,CONMK,CONMKM .GLOBL ˙LENWD,LENMK,LENMKM,PARXWD,PARXMK,PARXMM .GLOBL ˙COMWD,COMMKM,COMMK,ADJWD,ADJMKM,ADJMK .GLOBL ˙EQUVWD,EQUVMM,EQUVMK,PARWD,PARMKM,PARMK .GLOBL ˙SERWD,SERMK,SERMKM,NXSYWD,SYM1WD,SYM2WD .GLOBL ˙SGLWD,SGLMK,SGLMKM,ASGWD,ASGMK,ASGMKM .GLOBL ˙EXPWD,EXPMK,EXPMKM,ADC ˙R3 ˙ ˙;THE FAKE ˙BNE ˙SUB03 ˙ ˙; SYMBOL TABLE ENTRY ˙CMP ˙ROUTIN,#2 ˙;IS THIS A FUNCTION? ˙BNE ˙SUB04 ˙ ˙;NO ˙MOV ˙FAKNAM,SYMSER+6 ˙;STORE THE ˙MOV ˙FAKNAM+2,SYMSER+10 ; FAKE NAME SUB04: ˙JSR ˙PC,NXTCH ˙;SKIP OVER LEFT PAREN ˙CMPB ˙R2,#'( ˙ ˙;ARE THERE PARAMETERS?? ˙BNE ˙NOLST ˙ ˙;NO ˙CLR ˙PARCNT ˙ ˙;CLEAR THE PARAMETER COUNT SUBLP: ˙JSR ˙PC,GET ˙ ˙;GET A PARAMETER ˙TST ˙R3 ˙ ˙;IS IT AVARIABLE NAME?? ˙BNE ˙BADPAR ˙ ˙;NO ˙MOV ˙CURSYM,R0 ˙;YES, SET THE PARAMETER FLAG ˙BIS ˙#PARMŽ220 ˙;ADD R4 BACK IN ˙ADD ˙R4,R5 ˙ ˙;CALCULATE THE BLOCK POSITION ˙ ˙ ˙ ˙;OF THE ERROR MESSAGE IN THE BLOCK ˙DEC ˙R3 ˙ ˙;RESTORE THE COUNT TOO SYN220: ˙MOV ˙R3,DIBNO ˙;PUT BLOCK # IN BLOCK BLOCK ˙MOV ˙#4,DIBLOK ˙;SET FUNCTION TO "INPUT" ˙MOV ˙#DIBLOK,-(SP) ˙;READ IN BLOCK ˙MOV ˙#DILINK,-(SP) ˙EMT ˙11 ˙MOV ˙#DILINK,-(SP) ˙;WAIT ˙EMT ˙1 ˙MOV ˙DIBUF,R4 ˙;CALCULATE ADDRESS OF MESSAGE SYN203: ˙TST ˙R5 ˙BEQ ˙SYN202 ˙ADD ˙#64.,R4 ˙DEC ˙R5 ˙BR ˙SYN203 SYN202:;MOVE ENGLISH MESSG FOLLE END OF THE TEMPORARY CODE - NASTY ISN'T IT????? SCAN8A: ˙JSR ˙PC,@(SP)+ ˙;DO "TYPE" OR "IMPLICIT" ˙BR ˙SCAN13 ˙ ˙;AND RETURN TO LOOP SCAN11: ˙CMP ˙@SP,#IMPLIC ˙;IS THE ERROR ON AN IMPLICIT?? ˙BEQ ˙SCAN19 ˙ ˙;YES, TELL USER ˙TST ˙(SP)+ ˙ ˙;OTHERWISE TRY TO FIND ˙BR ˙SCAN14 ˙ ˙; ANOTHER MATCH SCAN19: ˙TRAP+3 ˙ ˙ ˙;TELL USER THAT TYPE IS BAD ˙MOV ˙#2,R0 ˙ ˙;ASSUME HE MEANT INTEGER ˙BR ˙SCAN8A ˙ ˙;NOW GO TRY TO CONTINUE ; ; MODE TABLE TO MATCH ORDER OF N11 THRU N20. ; MODE: ˙.BYTE ˙0,1,2,BPWD,VALUE,SYMBYT,SYMSIZ .GLOBL ˙XPRWD,XPRMK,XPRMKM,ADBCUR,SYMBAS,LOGREL .GLOBL ˙T1,T2,T3,T4,T5,T6,T7,T8,T9 .GLOBL ˙T10,T11,T12,T13,T14,T15,T16 .GLOBL ˙T17,T18,T19,T20,T21,T22,T23 .GLOBL ˙T24,T25,$RCI,$DCI,NAMSER,SYMSER ;SPECIAL REGISTER ASSIGNMENTS R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ;TEMPORARIES ARE INDEXED OFF THE STACK T1=0 T2=2 T3=4 T4=6 T5=10 T6=12 T7=14 T8=16 T9=20 T10=22 T11=24 T12=26 T13=30 T14=32 T15=34 T16=36 T17=40 T18=42 T19=44 T20=46 T21=50 ‘KM,PARWD(R0) ;IN THE ENTRY ˙ADD ˙#2,PARCNT ˙CMP ˙PARCNT,#377 ˙;TOO MANY PARAMETERS? ˙BGT ˙PARERR ˙ ˙;YES ˙MOVB ˙PARCNT,PARXWD(R0) ; NOW SET THE PARAMETER INDEX ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙CMPB ˙R2,#', ˙ ˙;IS IT A COMMA ˙BNE ˙SUBDON ˙ ˙;NO ˙BR ˙SUBLP ˙ ˙;GO GET ANOTHER SUBDON: ˙CMPB ˙R2,#') ˙ ˙;ALL DONE?? ˙BEQ ˙SUBDN1 ˙ ˙;YES SUBDN2: ˙TRAP+12. ˙ ˙;BAD CHARACTER TERMINATING STMT SUBDN1: ˙RTS ˙PC ˙ ˙;NOW RETURN NOLST: ˙TST ˙R2 ˙ ˙;GOOD TERMINATOR?? ˙BEQ ˙SUBDN3 ˙ ˙;YES ˙TRAP+1’EWD BY CR-LF ; TO LIST AND OBJ DEVICES ;MOVE MSSG TO DBUF ˙MOV ˙#DBUF,R5 SYN211: ˙CMP ˙R5,#DBUF+64. ˙;LOOP OVER? ˙BHIS ˙SYN210 ˙;BR IF YES ˙MOVB ˙(R4)+,(R5)+ ˙;ELSE, MOVE NXT CH. ˙BR ˙SYN211 SYN210: ˙MOVB ˙#015,(R5)+ ˙;APPEND CR/LF ˙MOVB ˙#012,(R5)+ ˙MOV ˙#66.,R5 ˙;COUNT ˙JSR ˙PC,OUTDGN ˙ADD ˙#2,DIPTR SYN108: ˙CMP ˙DIPTR,ERRCUR ˙;MORE TABLE ENTRIES TO PROCESS? ˙BLO ˙SYN15A ˙ ˙;BR IF YES ˙CMP ˙DIPTR,#ERREND ˙;IF NOT, WAS THERE TABLE OVERFLOW? ˙BNE ˙SYN008 ˙ ˙;BR IF NOT ;ELSE, WR“2,4,4,5,4,3,3 ˙.EVEN ; ; TABLE OF NON-EXECUTABLE PROTOTYPES ; NEXTBL: ˙N1 ˙N2 HDRN: ˙N10 ˙N3 ˙N3A BDATA: ˙N4 ˙N5 ˙N6 ˙N7 ˙N8 ˙N9 ˙N10A NXTBL1: ˙N11 ˙N12 ˙N13 ˙N14 ˙N15 ˙N16 ˙N17 ˙N18 ˙N19 ˙N20 ˙N21 ˙0 ; END OF PART 1 ; ; START OF PART 2 N1: ˙.ASCII ˙/SUBROUTINE/ N2: ˙.ASCII ˙/FUNCTION/ N10: ˙.ASCII ˙/BLOCKDATA/ N3: ˙.ASCII ˙/EXTERNAL/ N3A: ˙.ASCII ˙/DEFINEFILE/ N4: ˙.ASCII ˙/TYPE/ N5: ˙.ASCII ˙/DIMENSION/ N6: ˙.ASCII ˙/COMMON/ N7: ˙.ASCII ˙/EQUI”T22=52 T23=54 T24=56 T25=60 T26=62 T27=64 T28=66 T29=70 T30=72 ; ;DEFINITION OF SYMBOL TABLE ENTRY FORMAT. ; NAMMK=176777 NAMMKM=001000 NAMWD=0 ENTYWD=0 ˙;WORD CONTAINING ENTRY TYPE ENTYMM=140000 ENTYMK=037777 ˙;MASK FOR ENTRY TYPE (COMPLIMENT) DATYWD=0 ˙;DATA TYPE WORD (*2) DATYMK=143777 ˙;DATA TYPE MASK (COMPL) DATYMM=034000 DIMWD=12 ˙ ˙;DIMENSION WORD ˙(*2) DIMMK=174777 ˙;DIMENSION MASK (COMPL) DIMMKM=003000 CONWD=0 ˙ ˙;CONSTANT INDICATOR WORD (*2) CONMK=177377 ˙;CONSTANT I•2. ˙ ˙;NO SUBDN3: ˙BIC ˙#ENTYMM,ENTYWD(R0) ;RESET TO A ˙BIS ˙#100000,ENTYWD(R0) ;FUNCTION ˙BIS ˙#NAMMKM,NAMWD(R0) ˙;SET NAME FLAG ˙RTS ˙PC ; ; FUNCTION HANDLING ; FUNCTI: ˙CLR ˙PARCNT ˙ ˙;CLEAR THE COUNT ˙BR ˙FUNCT1 FUNC: ˙BIS ˙#100000,R0 ˙;SET THE SIGN BIT ˙MOV ˙R0,PARCNT ˙;PLACE IN TEMPORARY FUNCT1: ˙MOV ˙#2,ROUTIN ˙;SET FUNCTION MODE ˙BR ˙SUB01 FAKNAM: ˙.RAD50 ˙/$FV/ ˙;FUNCTION ˙.RAD50 ˙/AL/ ˙;VALUE NAME ; PARERR: ˙TRAP+57. ˙RTS ˙PC BADSUB: ˙TRAP+54. ˙RTS ˙PC BDSUB1: ˙TRAP–ITE A "TABLE OVERFLOW" MESSAGE ˙MOV ˙#DBUF,R5 ˙MOV ˙#SYN900,R4 ˙;MOVE MESSAGE TO DBUF SYN213: ˙CMP ˙R5,#SYN901-SYN900+DBUF ˙BHIS ˙SYN212 ˙;BR IF LOOP OVER ˙MOVB ˙(R4)+,(R5)+ ˙BR ˙SYN213 SYN212: ˙MOVB ˙#015,(R5)+ ˙;APPEND CRLF ˙MOVB ˙#012,(R5)+ ˙SUB ˙#DBUF,R5 ˙;GET COUNT ˙JSR ˙PC,OUTDGN ;CLOSE AND RELEASE THE MESSAGE FILE SYN008:; IF DIAG FILE NOT PRESENT, ;DON'T TRY TO CLOSE OR RELEASE ˙TST ˙DIFEX ˙BNE ˙SYN007 ˙MOV ˙#DILINK,-(SP) ˙;CLOSE ˙EMT ˙17 ˙MOV ˙#DILINK,-(SP) ˙EMT ˙—VALENCE/ N8: ˙.ASCII ˙/DATA/ N9: ˙.ASCII ˙/IMPLICIT/ N10A: ˙.ASCII ˙/END/ N11: ˙.ASCII ˙/LOGICAL*1/ N12: ˙.ASCII ˙/LOGICAL/ N13: ˙.ASCII ˙/INTEGER*2/ N14: ˙.ASCII ˙/INTEGER/ N15: ˙.ASCII ˙/DOUBLEPRECISION/ N16: ˙.ASCII ˙/DOUBLE/ N17: ˙.ASCII ˙/COMPLEX/ N18: ˙.ASCII ˙/REAL*8/ N19: ˙.ASCII ˙/REAL*4/ N20: ˙.ASCII ˙/REAL/ N21 ˙= ˙. ˙.EVEN ; END OF PART 2 ; ; FUNCTION PROTOTYPE FOR SPECIAL FUNCTION FORMS ; FNTBL: ˙N2 ˙N10 ˙0 ; ˙.GLOBL ˙OV2JMP,IMPLIC,TYPE,FUNCTO,OV1JMP ; NEXJMP: ˙O˜NDICATOR MASK (COMPL) CONMKM=000400 LENWD=0 ˙ ˙;LENGTH OF DATA ITEM WORD (*2) LENMK=177400 ˙;LENGTH OF DATA ITEM MASK (COMPL) LENMKM=000377 PARXWD=0 ˙;PARAMETER INDEX WORD (*2) PARXMK=177400 ˙;PARAMETER INDEX MASK (COMPL) PARXMM=000377 ALLOWD=2 ˙ ˙;"STORAGE HAS BEEN ALLOCATED" IND. ALLMK=137777 ALLMKM=040000 COMWD=2 ˙ ˙;COMMON INDICATOR WORD (*2) COMMKM=100000 COMMK=077777 ˙;COMMON INDICATOR MASK (COMPL) ADJWD=0 ˙ ˙;ADJUSTABLE ARRAY IND WORD (*2) ADJMKM=002000 ADJMK=175777 ˙;ADJUSTABLE ARR+55. ˙RTS ˙PC BADPAR: ˙TRAP+56. BADP1: ˙JSR ˙PC,NXTCH ˙CMPB ˙R2,#', ˙BEQ ˙SUBLP ˙CMPB ˙R2,#') ˙BNE ˙BADP1 ˙RTS ˙PC ˙.END š7 SYN007: ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R4 ˙;RESTORE ˙MOV ˙(SP)+,R3 ˙; REGISTERS ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R1 ˙MOV ˙(SP)+,R0 ˙MOV ˙#ERRS,ERRCUR ˙;REINITIALIZE DIAGNOSTIC TABLE ˙MOV ˙#5015,DBUF ˙; PACKED ˙MOV ˙#2,R5 ˙ ˙;COUNT OF TWO ˙JSR ˙PC,OUTDGN ˙;OUTPUT A BLANK LINE ˙RTS ˙PC ˙ ˙;AND RETURN TO COMPILER ;OUTPUT WHATEVER IS IN THE DIAGNOSTIC BUFFER, DBUF ;COUNT IS IN R5. OUTPUT GOES TO OBJECT AND LIST DEVICE ;COUNT SHOULD NOT INCLUDE LEADING ";" OUTDGN: ˙MOV ˙R5,-(SP) ˙;SAVE ›V1JMP ˙;SUBROUTINE IS IN OVERLAY 1 ˙OV1JMP ˙;FUNCTION IS IN OVERLAY 1 ˙BLOCKD ˙OV1JMP ˙;EXTERNAL IS IN OVERLAY 1 ˙OV1JMP ˙;DEFINEFILE IS IN OVERLAY 1 BJMP: ˙SCAN6 ˙ ˙;SPECIAL HANDLING FOR "TYPE" ˙OV1JMP ˙;DIMENSION IS IN OVERLAY 1 ˙OV2JMP ˙;COMMON IS IN OVERLAY 2 ˙OV2JMP ˙;EQUIVALENCE IS IN OVERLAY 2 ˙OV2JMP ˙;DATA IS IN OVERLAY 2 ˙SCAN18 ˙ ˙;SPECIAL HANDLING FOR "IMPLICIT" ˙END ; ; BLOCK DATA IS EASY TO HANDLE SO IS DONE HERE ; BLOCKD: ˙TSTB ˙@R1 ˙ ˙;END OF LINE?? ˙BEQ ˙BLOCK2 œAY IND MASK EQUVWD=2 ˙;EQUIVALENCE IND. WORD EQUVMM=020000 EQUVMK=157777 ˙;EQUIVALENCE IND. MASK PARWD=2 ˙ ˙;PARAMETER IND. WORD PARMK=167777 ˙;PARAMETER IND. MASK PARMKM=010000 SERWD=2 ˙ ˙;SERIAL NO. WORD SERMK=170000 ˙;SERIAL NO. MASK SERMKM=007777 NXSYWD=4 ˙;POINTER TO NEXT ENTRY (REL. TO START OF TABLE) SYM1WD=6 ˙;1ST HALF OF SYMBOL (WORD. MOD40) SYM2WD=10 ˙;2ND HALF OF SYMBOL (WORD, MOD40) SGLWD=12 ˙;SINGLE OCCURRENCE IND. SGLMK=077777 SGLMKM=100000 ASGWD=12 ˙ ˙;ASSIGNED GO TO INDIC; ; 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 ˙HEAD05 ˙.GLOBL ˙ELOC,EXECU,ENDFL,OVJMP,BEG,LGT ˙.CSECT ;OVERLAY 5 HEADER ;WARNING-HEAD03, HEAD04, HEAD05 MUST BE THE SAME LENGTH BEG: ˙. ˙;0 LGT: ˙ELOC ˙;2 ˙EXECU ˙;4 ˙ENDFL ˙;6 ˙OVJMP ˙;10 ˙0 ˙;12-FILLER ˙.END žCOUNT FOR 2ND CALL ˙INC ˙R5 ˙ ˙;BUMP R5 TO INCLUDE SEMICOLON ˙MOV ˙#SYN006,R4 ˙;PTR TO DESCRIPTOR OF OBJ DEV. ˙JSR ˙PC,OUTPUT ˙MOV ˙(SP)+,R5 ˙;RECALL COUNT ˙MOV ˙#SYN005,R4 ˙;PTR TO DESCR FOR LIST DEV ˙JSR ˙PC,OUTPUT ˙RTS ˙PC ;RETURN ROUTINE IN THE EVENT OF .INIT OR .OPEN ERROR ; ON DIAGNOSTIC FILE SYNFER: ˙MOV ˙#1,DIFEX ˙;SET FLAG TO "NOT "PRESENT" ˙JMP ˙SYN106 CHARS: ˙.BYTE ˙'[,'],15,12,0 ˙.ASCII ˙/ERROR/ ˙.BYTE ˙0,15,12 ; ;"TABLE OVERFLOW/; SYN900: ˙.ASCII ˙/;***DIAGNOSTIC TAŸ˙ ˙;YES ˙TRAP+12. ˙ ˙;NO BLOCK2: ˙INC ˙BLKDAT ˙ ˙;DISALLOW EXECUTABLES ˙MOV ˙#BLKD,R1 ˙;GET ADDRESS OF "DATA." ˙MOV ˙#MODNAM,R0 ˙.GLOBL ˙MODNAM ˙JSR ˙PC,PACK00 ˙MOV ˙#MODNAM,R0 ˙JSR ˙PC,HDRGEN ˙;CALL HEADER BUILDER ˙CLV ˙RTS ˙PC ˙ ˙˙;AND RETURN ; ˙.END  ATOR ASGMK=137777 ASGMKM=040000 EXPWD=12 ˙;EXPLICITLY TYPED VARIABLE IND. EXPMK=157777 EXPMKM=020000 XPRWD=12 ˙;"USED OUTSIDE THE 'ASSIGN' COMPLEX XPRMK=167777 ˙;AND DURING AN EXECUTABLE STATEMENT" IND. COMNWD=12 ˙ ˙;COMM. BLOCK INDICATOR XPRMKM=010000 ADBPWD=14 ˙;POINTER TO ADB(REL TO START OF SYM TBL) VALUE=20 ˙;BEGINNING OF WORDS CONTAINING VALUE SYMBYT=20 ˙;NO. BYTES IN SYM. TABLE ENTRY (FXD PART) SYMSIZ=10 ˙;NO. WORDS IN SYM. TABLE ENTRY (FXD PART) COMNWD ˙= ˙12 ˙;LOW BYTE OF WORD=COM˘BLE OVERFLOW/ ˙.BYTE ˙015,012 SYN901=. ˙.EVEN ; ;"BLOCK" BLOCK FOR RANDOM ACCESS TO THE ;CONTIGUOUS FILE OF COMPILER DIAGNOSTICS ; DIBLOK: ˙0 ˙;FUNCTION DIBNO: ˙0 ˙;BLOCK # DIBUF: ˙0 ˙;BUFFER ADDR. DILEN: ˙0 ˙;LENGTH OF BUFFER ; ;LINK BLOCK ˙.WORD ˙SYNFER ˙ ˙;ERROR RETURN ADDRESS DILINK: ˙.WORD ˙0 ˙ ˙;LINK POINTER ˙.RAD50 ˙/DGN/ ˙;DATA SET ˙.BYTE ˙1 ˙ ˙;# WORDS ˙.BYTE ˙0 ˙.RAD50 ˙/DF/ ˙ ˙;DEVICE ; ;FILE BLOCK ; ˙.WORD ˙SYNFER ˙ ˙;ERROR RETURN ˙.BYTE ˙1 ˙.BYTE ˙0 DIFILE:¤MON BLOCK SEQUENCE NO. ; ;CONINT CONVERTS AN ASCII INTEGER TO BINARY:-USE JSR PC,CONINT ;INPUT: ˙R1 POINTS TO THE FIRST BYTE OF THE INPUT ASCII STRING. ;OUTPUT:R3 WILL CONTAIN THE OUTPUT INTEGER. ;INPUT: ˙R4 MUST ON INPUT POINT TO A PLACE WHERE ; THE INPUT CAN BE MOVED TO. ;OUTPUT:R1 WILL POINT TO THE BYTE WHICH TERMINATED THE CONVERSION. ; ˙R5 GETS CLOBBERED;(R4)=NEXT AVAILABLE BYTE FOR STORAGE. ;OUTPUT:V=1 IF NUMBER EXCEEDED 1Ľ; ; 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 ˙ENDSTM ˙.GLOBL ˙ZLEQLS,EXEC,NXTCH,END003,SCAN2A,ENDFIL,END R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ; "END" STATEMENT PRE-CHECK PROCESSOR ; END: ˙JSR ˙PC,ZLEQLS ˙;CHECK FOR ZERO LEVEL EQUAL ˙BŚ ˙.RAD50 ˙/FOR/ ˙ ˙;FILE NAME ˙.RAD50 ˙/COM/ ˙.RAD50 ˙/DGN/ ˙.WORD ˙401 ˙;USER[1,1] ˙.BYTE ˙0 ˙.BYTE ˙0 ; DIFACT: ˙0 ˙;BLOCK SIZE OF DIAG. ˙ ˙;DIVIDED BY 64 DIPTR: ˙0 ˙;SCRATCH POINTER DIFEX: ˙0 ˙;ZERO IF FILE EXISTS ; ;I/O DESCRIPTORS - ;SYN005=LIST FILE, DBUF (MINUS LEADING ";") ;SYN006=OBJECT FILE, DBUF (INCLUDING LEADING ";") SYN005: ˙CODE ˙LINKSL SYN006: ˙DIAG ˙LINKOL ; ˙.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 ˙IMP004 ;IMPLICIT PROCESSOR - ENTERED WITH MODE IN LOW ORDER R0 ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .GLOBL ˙IMPL,IMPTAB,CNXC1,CHTEST,CNXC IMPL: ˙;SHIFT MODE TO RIGHT PLACE ˙ASL ˙R0 ˙ASL ˙R0 ˙ASL ˙R0 ;IF CURR CHAR¨5 BITS; V=0 OTHERWISE CONINT: ˙CLR ˙R3 ˙ ˙;INITIALIZE RESULT ACCUMULATOR CON02: ˙JSR ˙PC,CHTEST ˙;CHECK CURRENT CHARACTER TYPE. ˙BMI ˙CON035 ˙ ˙;BR IF A DIGIT (N=1) ˙CLV ˙ ˙ ˙;ELSE, RETURN WITH V=0 ˙RTS ˙PC CON035: ˙MOVB ˙R2,(R4)+ ˙;PUT CHAR. INTO R4 AREA ˙SUB ˙#60,R2 ˙ ;STRIP OFF ASCII, LEAVING BINARY EQUIV. ˙MOV ˙R3,R5 ˙ ˙;MULTIPLY (R3) BY 10 ˙ASL ˙R3 ˙ ˙;(R3)*2 ˙BMI ˙CON01 ˙ ;BR IF MINUS SIGN GOT SET (OVFLO) ˙ASL ˙R3 ˙ ˙;(R3)*2*2 ˙BMI ˙CON01 ˙ ˙;CHECH OVERFLOW AGAIN ˙ASL ˙R3 ˙ ˙;ŠCC ˙END002 ˙ ˙;NOT THERE END001: ˙SEV ˙ ˙ ˙;OTHERWISE NOT AN END ENDF2: ˙RTS ˙PC END002: ˙JSR ˙PC,NXTCH ˙;CHECK FOR A REAL END ˙TST ˙R2 ˙BNE ˙ENDF ˙ ˙;IT ISN'T AN END UNLESS ˙JMP ˙END003 ˙ ˙;IT IS TERMINATED!! ; ; HERE WE CHECK FOR ENDFILE BECAUSE OF A CROCK IN THE VERB SCAN ; ENDF: ˙DEC ˙R1 ˙ ˙;BACK UP THE POINTER ˙MOV ˙#ENDF1,R0 ˙JSR ˙PC,SCAN2A ˙;CHECK FOR "FILE" ˙BVS ˙ENDF2 ˙MOV ˙#1,EXEC ˙ ˙;MUST BE EXECUTABLE ˙JMP ˙ENDFIL ENDF1: ˙E1 ˙E2 ˙0 E1: ˙.ASCII ˙/FILE/ E2 ˙= ˙. ˙Ť IS A LEFT PAREN, STEP OVER IT ˙JSR ˙PC,CNXC ˙;GET A NON-BLANK ˙CMPB ˙(R1),#'( ˙BNE ˙IM01 IM03: ˙JSR ˙PC,CNXC1 IM01: ˙JSR ˙PC,CHTEST ˙;IS NEXT CH. A LETTER ˙BVC ˙IM02 ˙ ˙;BR IF NOT ˙MOVB ˙(R1),R3 ˙ ˙;ELSE, SAVE CH. ˙MOVB ˙R0,IMPTAB-101(R3) ˙;MODIFY IMPLICIT TABLE ˙JSR ˙PC,CNXC1 ˙;GET NEXT IM02: ˙CMPB ˙(R1),#'- ˙;IS CH A DASH ˙BNE ˙IM04 ˙ ˙;BR IF NOT ˙JSR ˙PC,CNXC1 ˙;ELSE GET NEXT CH FOR OTHER LIMIT ˙JSR ˙PC,CHTEST ˙;CH MUST BE A LETTER ˙BVC ˙IM021 ˙ ˙;BR IF NOT, SYNTAX ERROR ˙CŹCHECK OVERFLOW AGAIN ˙ADD ˙R5,R3 ˙ ˙;((R3)*8)+(R3) ˙BVS ˙CON01 ˙ ˙;CHECK OVERFLOW ˙ADD ˙R5,R3 ˙ ˙;((R3)*9)+(R3)=R3+10 ˙BVS ˙CON01 ˙ ˙;CHECK OVERFLOW ˙ADD ˙R2,R3 ˙ ˙;ADD IN CURRENT DIGIT ˙BVS ˙CON01 ˙ ˙;CHECH OVERFLOW ˙JSR ˙PC,CNXC1 ˙;GET NEXT NON-BLANK CH. ˙JSR ˙PC,CON03 ˙;PUT CH, AWAY VIA RD ˙BR ˙CON02 ; ;LITTLE SUBROUTINE TO CHECK FOR AVAILABLE SPACE IN BUILD AREA ; CON03: ˙CMP ˙R4,SYMEND ;CHECH THAT R4 IS NOT BEYOND ˙BLOS ˙CON031 ˙ ˙;SYMBOL TABLE.--BR IF OK ˙TRAP+16 ˙ ˙ ˙;ELS.EVEN ˙.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 ˙DO ˙.GLOBL ˙DO,DOTMP,NXTCH,CHT1,PACK00,FLABL,GET ˙.GLOBL ˙CURSYM,IOL,GENLAB,OUTTAB,SERWD,OUTSER ˙.GLOBL ˙EOL,ASGCOM,OUTCOL,DOLST,DOEND,PARMKM ˙.GLOBL ˙PARWD,PARXWD,ENDX1 ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙=ŻMPB ˙(R1),R3 ˙ ˙;CH MUST BE > FIRST LETTER ˙BLOS ˙IM021 ˙ ˙;BR IF NOT, SYNTAX ERROR ˙MOVB ˙(R1),R4 IM022: ˙MOVB ˙R0,IMPTAB-101(R3) ;SET NEXT TABLE ENTRY TO DESIGNATED TYPE ˙INC ˙R3 ˙CMP ˙R3,R4 ˙BLOS ˙IM022 ˙ ˙;BR IF LOOP MORE ˙BR ˙IM03 ˙ ˙;LOOP DONE. LOOK AT NEXT CH. IM04: ˙CMPB ˙(R1),#', ˙;IS CH A COMMA? ˙BEQ ˙IM03 ˙ ˙;IF YES, GET NEXT CH. ˙CMPB ˙(R1),#') ˙;ELSE IS CH. A RT PAREN? ˙BEQ ˙IM0221 ˙ ˙;IF SO, END OF STATEMENT ˙TSTB ˙(R1) ˙ ˙;IS CH. E.O.L.? ˙BNE ˙IM021 ˙ ˙;IF NOT, SYNTA°E, ISSUE DIAGNOSTIC. ˙MOV ˙LOW,SP ˙ ˙;ABORT ˙JMP ˙SCANNR ˙ ˙;THIS STATEMENT CON031: ˙RTS ˙PC CON01: ˙;OVERFLOW OCCURED. ; PASS OVER INPUT UNTIL A NON-DIGIT IS ENCOUNTERED. ˙;SET INTEGER VALUE TO ZERO. ˙JSR ˙PC,CNXC1 ˙;GET NEXT CH. ˙JSR ˙˙PC,CHTEST ˙;IF DIGIT, KEEP GOING ˙BMI ˙CON011 ˙ ˙;BR IF N=1,DIGIT ˙MOV ˙#077777,R3 ;SUBSTITUTE LARGEST POS VAL ˙SEV ˙ ˙;SET V=1 ˙RTS ˙PC CON011: ˙JSR ˙PC,CON03 ˙;CHECK IF NEXT BYTE FITS ˙MOVB ˙(R1),(R4)+ ˙BR ˙CON01 ; ; ą; ; 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 ˙INIT00 ; ; THIS ROUTINE IS USED TO OUTPUT COMPILER OVERLAY #0 ; ˙TO THE DISK IN IMAGE FORM ; R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; ˙.CSECT ; ˙.GLOBL ˙BEG,LGT,TLB,FB0,FB1,FB2,FB3,FB4,FB5 ˛ ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; TAB ˙= ˙11 ; ; DO STATEMENTS ARE SET UP HERE - THE DO ENTRY IS MADE ; DO: ˙MOV ˙#DOTMP+4,R4 DO02: ˙MOV ˙R4,R3 DO02B: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙JSR ˙PC,CHT1 ˙ ˙;CHECK FOR NUMERIC ˙BPL ˙END ˙ ˙;NOT NUMERIC ˙CMP ˙R4,R3 ˙ ˙;SUPPRESS ZERO ? ˙BEQ ˙ZRTST ˙;YES NOZRO: ˙MOVB ˙R2,(R3)+ ˙;STORE A CHARACTER ˙CMP ˙R3,#DOTMP+12 ˙;ALL DONE? ˙BHIS ˙END1 ˙ ˙;YES ˙BR ˙DO02B ˙ ˙;RELOOP ZRTST: ˙CMPB ˙R2,#'0 ˙ ˙;IS IT A LEADING ZERO? ˙BEQ ˙DO02B ˙ ˙;YES ˙BR ˙NOZX ERROR. IM0221: ˙CLV ˙ ˙ ˙;RETURN ˙RTS PC IM021: ˙TRAP+77. ˙ ˙;SYNTAX ERROR IN IMPLICIT STATEMENT ˙BR ˙IM0221 ˙.END ´; ; ;CONCOM ˙COMPARES VALUE IN SYM.TBL. ENTRY (VIA R3) WITH ;THE CONSTANT POINTED TO BY R0 (SIZE IN BYTES IN R4) ; ˙DESTROYS R5 ;R5 SHOULD CONTAIN MODE OF CONSTANT IN BITS 13-11 ON INPUT ;OTHER BITS IN THAT WORD MAY BE SET, WILL BE IGNORED. ;RETURNS: ˙Z=1 ˙ITEMS EQUAL ; ˙ ˙ =0 ˙ITEMS UNEQUAL ; CONCOM: ˙MOV ˙R0,-(SP) ˙;SAVE R0 ˙MOV ˙R2,-(SP) ˙;SAVE R2 ˙BIT ˙#CONMKM,CONWD(R3) ;IS ENTRY FOR A CONSTANT? ˙BEQ ˙CONC01 ˙ ˙;BR IF NOT A CONSTANT, NO MTCH ;ľ; INIT: ˙MOV ˙PC,SP ˙ ˙;SET UP ˙TST ˙-(SP) ˙ ˙;A STACK ˙MOV ˙LGT,R0 ˙;GET NUMBER OF BYTES TO OUTPUT ˙SUB ˙BEG,R0 ˙MOV ˙#7,R1 ˙ ˙;WE DIVIDE BY 2^7 FOR NUMBER OF BLOCKS INIT0: ˙ASR ˙R0 ˙ ˙;LOOP ˙DEC ˙R1 ˙ ˙;UNTIL DONE ˙BNE ˙INIT0 ˙ ˙; ˙INC ˙R0 ˙ ˙;ALLOCATE EXTRA BLOCK FOR ROUNDOFF ˙MOV ˙R0,-(SP) ˙;NOW ˙MOV ˙#TLB,-(SP) ˙;INIT ˙EMT ˙6 ˙ ˙;THE DISK ˙MOV ˙#FB0,-(SP) ˙; ALLOCATE ˙MOV ˙#TLB,-(SP) ˙; SOME ˙EMT ˙15 ˙ ˙; CONTIGUOUS SPACE ˙TST ˙(SP)+ ˙ ˙;DID IT WORK OK?? ˙BPL ˙INIT1 ˙śRO ˙ ˙;NO, GET ANOTHER CHARACTER END: ˙DEC ˙R1 ˙ ˙;BACK UP OVER BAD CHARACTER ˙CLRB ˙(R3)+ ˙ ˙;SET TERMINATOR END1:ENDX1: ˙MOV ˙R1,-(SP) ˙;SAVE R1 TEMPORARILY ˙MOV ˙R4,R1 ˙ ˙;RESET POINTER ˙MOV ˙#DOTMP,R0 ˙MOV ˙R4,-(SP) ˙;SAVE R4 ˙JSR ˙PC,PACK00 ˙;GET THE LINE NUMBER ˙MOV ˙(SP)+,R4 ˙;RESTORE R4 ˙MOV ˙(SP)+,R1 ˙;RESTORE R1 ˙TST ˙-(R0) ˙ ˙;IT IS A DO ˙BNE ˙DO02A ˙ ˙;IF ˙TST ˙-(R0) ˙ ˙; THE NUMBER IS NON-ZERO ˙BEQ ˙NOTDO ˙ ˙;CAN'T BE A DO IF ZERO DO02A: ˙MOV ˙FLABL,(R4)+ ˙;SAVE LABELˇ; ; 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 ˙HEAD01 ˙.GLOBL ˙ELOC,SCANN,OVJMP,IMPL,FUNC,BEG,LGT ˙.GLOBL ˙TYP,LSTX,QADX ˙.CSECT ;OVERLAY 1 HEADER ;WARNING-HEAD01, HEAD02, HEAD06 MUST BE THE SAME LENGTH BEG: ˙. ˙;0-BEGINNING OF OVERLAY LGT: ˙ELOC ˙;2-END OF OVERLAY ˙SCANN ˙;4-START O¸ELSE ARE MODES OF ENTRY AND CONSTANT EQUAL? ˙MOV ˙DATYWD(R3),-(SP) ˙;THIS RIGAMAROLE ˙BIC ˙#DATYMK,(SP) ˙;IS TO ISOLATE THE DESIRED ˙BIC ˙#DATYMK,R5 ˙;FIELDS IN THE TWO INPUTS. ˙CMP ˙R5,(SP)+ ˙;NOW COMPARE THEM... ˙BNE ˙CONC01 ˙;BR IF MODES UNEQUAL ;ELSE CONTINUE TESTING THE OTHER CRITERIA ˙CMPB ˙R4,LENWD(R3) ˙;ELSE ARE CONSTANTS SAME SIZE? ˙BNE ˙CONC01 ˙ ˙;BR IF NOT, NO MATCH ˙MOV ˙#SYMBYT,R5 ˙;ELSE GET BASE OF CONST IN ENTRY ˙ADD ˙R3,R5 ˙MOV ˙R4,-(SP) ˙;SAVE SIZE ˙BEQ ˙CONC02 ˙ ˙;š ˙;NO, SCREAM IN AGONY ˙MOV ˙#FB0,-(SP) ˙;NOW FIND ˙CLR ˙-(SP) ˙ ˙; OUT WHERE ˙MOV ˙#TLB,-(SP) ˙;THE FILE ˙EMT ˙14 ˙ ˙;WAS PLACED ˙MOV ˙(SP)+,TBLK ˙;GET THE DISK ADDRESS ˙ADD ˙#4,SP ˙ ˙;DISCARD JUNK ˙MOV ˙BEG,TBLK+2 ˙;CORE ADDRESS ˙MOV ˙LGT,R2 ˙ ˙;THE ˙SUB ˙BEG,R2 ˙ASR ˙R2 ˙ ˙;WORD COUNT ˙MOV ˙R2,TBLK+4 ˙;IS SAVED TOO ˙MOV ˙#TBLK,-(SP) ˙MOV ˙#TLB,-(SP) ˙EMT ˙10 ˙ ˙;NOW TRANSFER THE DATA ˙MOV ˙#TLB,-(SP) ˙;WAIT ˙EMT ˙1 ˙ ˙;UNTIL DONE ˙EMT ˙60 ˙ ˙;AND EXIT ; INIT1: ˙CLR ˙ş OF END PROCEDURE ˙INC ˙FLABL ˙ ˙;AND ADVANCE POINTER ˙MOV ˙R1,R0 ˙ ˙;TEMPORARILY REMEMBER CHARACTER POINTER DO03: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙TST ˙R2 ˙ ˙;IS IT A TERMINATOR? ˙BEQ ˙BADSTM ˙ ˙;CAN'T BE A DO OR ASSIGNMENT ˙JSR ˙PC,CHT1 ˙ ˙;MUST BE ALPHANUMERIC ˙BCC ˙DO03 ˙CMPB ˙R2,#'= ˙ ˙;FIND ˙BNE ˙NOTDO ˙ ˙; THE = DO04: ˙JSR ˙PC,NXTCH ˙;GET A CHARACTER ˙JSR ˙PC,CHT1 ˙ ˙;IS IT ALPHANUMERIC?? ˙BCC ˙DO04 ˙ ˙;YES, SKIP IT ˙CMPB ˙R2,#', ˙ ˙;NO, IT MUST BE A COMMA ˙BNE ˙NOTDO ˙ ˙ťF STATEMENT SCAN ˙OVJMP ˙;6-OVERLAY TRANSFER JUMP ˙IMPL ˙;10-IMPLICIT ˙FUNC ˙;12-SPECIAL FUNCTION ENTRY ˙TYP ˙;14-TYPE ˙LSTX ˙;16-LIST ITEM ˙QADX ˙;20-QADBOK ˙0 ˙;22-FILLER ˙.END źARE WE DONE COMPARING? CONC03: ˙CMP ˙(R0)+,(R5)+ ˙;IF NOT COMPARE NXT WORD OF EACH ˙BNE ˙CONC04 ˙ ˙;IF NOT EQUAL, EXIT ˙TST ˙-(R4) ˙ ˙;ELSE REDUCE COUNT ˙TST ˙R4 ˙ ˙;IS IT 0 ˙BNE ˙CONC03 ˙ ˙;BR IF MORE TO TEST CONC02: ˙MOV ˙(SP)+,R4 ˙;ELSE, ENTRIES MATCH ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R0 ˙SEZ ˙RTS ˙PC ;ITEMS UNEQUAL CONC04: ˙MOV ˙(SP)+,R4 CONC01: ˙MOV ˙(SP)+,R2 ˙MOV ˙(SP)+,R0 ˙CLZ ˙RTS ˙PC ; ; ; ;GET. ˙CALLED: ˙JSR ˙PC,GET ;INPUT- ˙R1 POINTS TO START OF THE BYTE STRING TO BE -(SP) ˙MOV ˙#1441,-(SP) ˙IOT ˙ ˙ ˙;DIE IN EXTREME AGONY ; TBLK: ˙0 ˙;START BLOCK ˙0 ˙;START CORE ADDRESS ˙0 ˙;WORD COUNT ˙2 ˙;WRITE ˙0 ˙;RESERVED ; ˙.END ˙INIT ž;NOT A DO STATEMENT ˙MOV ˙R0,R1 ˙ ˙;OK, IT IS A VERIFIED DO NOW. ˙JSR ˙PC,GET ˙ ˙;GET THE CONTROL VARIABLE ˙BVS ˙BADCV ˙ ˙;ILLEGAL CONTROL VARIABLE ˙TST ˙R3 ˙ ˙;IS IT A LEGAL C.V.?? ˙BNE ˙BADCV ˙ ˙;NO ˙MOV ˙CURSYM,(R4)+ ˙;REMEMBER SYMBOL TABLE ENTRY ˙CMPB ˙(R1)+,#'= ˙;IS THE EQUAL NEXT?? ˙BNE ˙BADCV ˙ ˙;NO, VARIABLE NAME IS WEIRD DO08: ˙JSR ˙PC,GET ˙ ˙;GET INITIAL VALUE ˙BVS ˙DO09 ˙ ˙;BAD PARAMETER ˙TST ˙R3 ˙ ˙;IS IT A CONSTANT OR SIMPLE VAR.? ˙BGT ˙DO09 ˙ ˙;NO ˙MOV ˙CURSYM,(R4)+ ŔSCANNED. ; ˙GETSW IS THE GLOBAL NAME OF A BYTE. ; ˙(GETSW)=0 MEANS NO SYMBOL TABLE ENTRIES WILL ; ˙BE MADE MADE FOR NUMERIC CONSTANTS. ; ˙(GETSW)=1 MEANS MAKE SYM. TBL. ENTRIES FOR ; ˙NUMERIC CONSTANTS. ; ˙WILL PROBABLY WANT TOCHECK THAT THE CONSTANT ; ˙WAS AN INTEGER, SINCE DIMENSIONING OF AN ARRAY ; ˙WAS PROBABLY TAKING PLACE. ; ;OUTPUTS-(R0)=SERIAL # OF DATUM IF GETSW=1;ELSE THE VALUE ; ˙OF THE CONSTANT IF THE ITEM IS AN INTEGER ; ˙(R2)=DATA TYPE OF DATUM ; ˙NOTE--GETSW IS TESTED BY "GET" Á; ; 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 ˙MSSIO ˙.GLOBL ˙BITM,GET,GENLAB,OUTTAB,OUTSER,EOL ˙.GLOBL ˙OUTLN1,NXTCH,MISC ˙.CSECT R0 ˙= ˙%0 R1 ˙= ˙%1 R2 ˙= ˙%2 R3 ˙= ˙%3 R4 ˙= ˙%4 R5 ˙= ˙%5 SP ˙= ˙%6 PC ˙= ˙%7 ; TAB ˙= ˙11 ; ; REWIND, BACKSPACE, ENDFILE ; ˙.GLOBL ˙REWIND,BAÂ˙;INITIAL PARAMETER ADDRESS ˙CMPB ˙(R1)+,#', ˙;IS THE COMMA NEXT?? ˙BNE ˙DO09 ˙ ˙;NO DO05: ˙JSR ˙PC,GET ˙ ˙;GET THE END VALUE ˙BVS ˙DO09 ˙ ˙;BAD END VALUE ˙TST ˙R3 ˙ ˙;IS IT A CONSTANT OR VARIABLE?? ˙BGT ˙DO09 ˙ ˙;NO, ERROR ˙JSR ˙PC,PVAL ˙ ˙;ENDING VALUE ADDRESS ˙TSTB ˙@R1 ˙ ˙;END OF STATEMENT? ˙BEQ ˙FIXSTP ˙;YES, SET STEP OF ONE ˙TST ˙IOL ˙ ˙;IS THIS AN IMPLIED DO? ˙BNE ˙FIXSTP ˙ ˙;YES, DON'T CHECK TERMINATOR ˙CMPB ˙(R1)+,#', ˙;IS THERE MORE?? ˙BNE ˙DO09 ˙ ˙;NO DO06: ˙JSR ˙PC,GEÄAND "PUTSYM" ; ˙(R3)= ˙-1 ˙CONSTANT ; ˙ ˙0 ˙VARIABLE ; ˙ ˙1 ˙ARRAY NAME ; ˙ ˙2 ˙FUNCTION NAME ;(R1)=DELIMITER. IF THE FIRST CH. IS NEITHER A DIGIT NOR A LETTER, ; ˙ ˙R1 IS UNCHANGED. ; ˙V=0, ˙NORMAL RETURN ; ˙ =1, ˙SOME TYPE OF ERROR HAS BEEN DETECTED ; ; ;GET CONSTANT ENTRY GETN: ˙SUB ˙#T30,SP ˙MOV ˙#1,T20(SP) ˙BR ˙GETN1 GET20A: ˙JMP ˙GET20 ˙;INTERMEDIATE HELP ; GET NORMAL ENTRY GET: ˙SUB ˙#T30,SP ˙ ˙;RESERVE TEMPORARIES ˙CLR ˙T20(SP) GETN1: ˙MOV ˙R4,T16(SP) ˙;SAVE R4,5 ˙MOV ˙R5,ĹCKSP,ENDFL REWIND: ˙MOV ˙#RWND,R5 ˙;GET REWIND PROTOTYPE ˙BR ˙TAPCOM BACKSP: ˙MOV ˙#BAK,R5 ˙;GET BACKSPACE PROTOTYPE ˙BISB ˙BITM+0,MISC+4 ˙;SET THE READ GLOBAL ˙BR ˙TAPCOM ENDFL: ˙MOV ˙#ENDF,R5 ˙;GET END-FILE PROTOTYPE TAPCOM: ˙JSR ˙PC,GET ˙˙ ˙;GET THE IDENTIFIER ˙BVS ˙ILLTAP ˙ ˙;NOT LEGAL ˙TST ˙R3 ˙ ˙;IS IT A SIMPLE VARIABLE OR CONST? ˙BGT ˙ILLTAP ˙ ˙;NO ˙CMP ˙R2,#2 ˙ ˙;IS IT INTEGER? ˙BLE ˙TAP001 ˙ ˙;YES ˙TRAP+74. ˙ ˙;NO TAP001: ˙JSR ˙PC,GENLAB ˙JSR ˙PC,OUTTAB ˙;NOW PUSH ˙MOV ĆT ˙ ˙;GET THE STEP ˙BVS ˙DO10 ˙ ˙;NOT GOOD ˙TST ˙R3 ˙ ˙;LEGAL STEP? ˙BGT ˙DO10 ˙ ˙;NO! DO07: ˙JSR ˙PC,PVAL ˙ ˙;STEP VALUE ADDRESS ˙TST ˙IOL ˙ ˙;IS THIS AN IMPLIED DO?? ˙BNE ˙DOGEN3 ˙ ˙;YES, DON'T CHECK TERMINATOR ˙TSTB ˙@R1 ˙ ˙;TERMINATOR?? ˙BNE ˙DO11 ˙ ˙;BAD TERMINATOR ˙BR ˙DOGEN ˙ ˙;GO GENERATE THE DO CODE DO10: ˙TRAP+49. FIXSTP: ˙MOV ˙R1,-(SP) ˙;SAVE R1 ˙MOV ˙#FUDGE,R1 ˙;SET STEP OF ONE ˙JSR ˙PC,GET ˙ ˙;GET THE CONSTANT ˙MOV ˙(SP)+,R1 ˙;RESTORE TEXT POINTER ˙BR ˙DO07 ˙ ˙;RETUČT17(SP) ;SET UP SYMBOL TABLE BUILD AREA FOR _AWPC,EXPGEN ˙;GENER ;GENERATE CODE FOR THE CALL TO THE OTS COMPAPANSION ; ˙MOV ˙SP,T18(SP) ˙ADD ˙#T7,T18(SP) ˙;SAVE ADDR OF BASE ˙˙MOV ˙T18(SP),R4 ˙;SET UP CALLING SEQ ˙MOV ˙#SYMBYT,R5 ˙;TO FILL ROUTINE ˙ADD ˙R4,R5 ˙CLR ˙R3 ˙TST ˙-(R5) ˙JSR ˙PC,FILL ˙MOV ˙R1,T1(SP) ˙;SAVE INITIAL VAL OF PTR ˙CLR ˙T5(SP) ˙;GENERATE A POSITIVE TERMINATOR ˙ ˙ ˙;TO SYMBOL DEVELOPED AT T2 ET É˙R0,R3 ˙ ˙; THE ˙MOVB ˙#'P,R0 ˙ ˙; VARIABLE ˙JSR ˙PC,OUTSER ˙JSR ˙PC,EOL ˙ ˙;GENERATE END-OF-LINE ˙MOV ˙R5,R4 ˙ ˙;GET CODEPROTOTYPE ˙JSR ˙PC,OUTLN1 ˙;OUTPUT IT ˙JSR ˙PC,NXTCH ˙;CHECK ˙TST ˙R2 ˙ ˙;END OF LINE ˙BEQ ˙TAP002 ˙ ˙; ˙TRAP+12. ˙ ˙;ILLEGAL TERMINATOR TAP002: ˙RTS ˙PC ILLTAP: ˙TRAP+73. ˙ ˙;ILLEGAL SYNTAX ˙RTS ˙PC ; RWND: ˙.ASCII ˙/ ˙.GLOBL ˙$RWIND/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$RWIND/ ˙.BYTE ˙15,12,0 BAK: ˙.ASCII ˙/ ˙.GLOBL ˙$BCKSP/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$BCKSĘRN TO MAIN HUNK OF CODE FUDGE: ˙.BYTE ˙'1,0 ˙ ˙;A CONSTANT ONE FOR DEFAULT STEP DOVF: ˙TRAP+41. ˙ ˙;DO LIST OVERFLOW ˙RTS ˙PC NOTDO: ˙SEV ˙ ˙ ˙;SET ERROR ˙RTS ˙PC ˙ ˙; AND RETURN BADSTM: ˙TRAP+46. ˙ ˙;ILLEGAL DO FORMAT ˙RTS ˙PC BADCV: ˙TRAP+47. ˙ ˙;BAD CONTROL VARIABLE BADCV1: ˙MOVB ˙(R1)+,R2 ˙BEQ ˙NODO ˙CMPB ˙R2,#'= ˙BNE ˙BADCV1 ˙BR ˙DO08 DO09: ˙TRAP+48. ˙CCC ˙RTS ˙PC ; DO11: ˙TRAP+12. DOGEN: ˙JSR ˙PC,GENLAB ˙;GENERATE A LABEL DOGEN3: ˙MOV ˙#DOTMP,R5 ˙JSR ˙PC,OUTTAB ˙;OUTPUĚSEQ. GET01: ˙JSR ˙PC,CNXC ˙ ˙;GET NEXT NONBLANK CH. ˙JSR ˙PC,CHTEST ˙;CHECK 1ST CHAR. ˙BMI ˙GET20A ˙ ˙;Z=1, DIGIT ˙BVS ˙GET03 ˙ ˙;V=1, LETTER GET021: ˙CMPB ˙(R1),#'. ˙BEQ ˙GET40A ˙CMPB ˙(R1),#'' ˙BEQ ˙GET50A ; ;EXIT - NEITHER LETTER NOR DIGIT ; GET09: ˙MOV ˙T16(SP),R4 ˙MOV ˙T17(SP),R5 ˙ADD ˙#T30,SP ˙ ˙;NEITHER LETTER NOR DIGIT. ˙SEV ˙ ˙ ˙;EXIT WITH V=1 ˙RTS ˙PC ; ; ; GET40A: ˙JMP ˙GET40 ˙;INTERMEDIATE HELP GET03: ˙MOV ˙SP,R5 ˙ ˙;CALCULATE ADDR OF SYMBOL AREA ˙ADD ˙#T2,R5 P/ ˙.BYTE ˙15,12,0 ENDF: ˙.ASCII ˙/ ˙.GLOBL ˙$ENDFL/ ˙.BYTE ˙15,12 ˙.ASCII ˙/ ˙$ENDFL/ ˙.BYTE ˙15,12,0 ˙.END ÎT A TAB ˙MOV ˙10(R5),R2 ˙;GET ADDRESS OF INITIAL VALUE ˙MOV ˙SERWD(R2),R3 ˙;GET SERIAL NUMBER ˙BIC ˙#170000,R3 ˙;CLEAR JUNK BITS ˙MOV ˙#'P,R0 ˙ ˙;AND ˙JSR ˙PC,OUTSER ˙;OUTPUT THE ˙JSR ˙PC,EOL ˙ ˙;PUSH AND AN END-OF-LINE ˙MOV ˙#6,R4 ˙JSR ˙PC,FIXP ˙ ˙;SET UP CONTROL VARIABLE JUNK ˙MOV ˙R5,-(SP) ˙;SAVE R5 ˙MOV ˙#2,R2 ˙ ˙;SET INTEGER MODE ˙JSR ˙PC,ASGCOM ˙;DO THE PROPER POP ˙MOV ˙(SP)+,R5 ˙;RESTORE R5 ˙MOV ˙4(R5),R3 ˙;GET THE LABEL SERIAL NUMBER ˙MOV ˙#'F,R0 ˙ ˙;AND GENERATE ˙JSRĐ ˙MOV ˙R5,T6(SP) ˙;MOV SYMBOL TO WORK AREA ˙JSR ˙PC,GETID ˙;GET 6 CHAR. OR AN ID ˙MOV ˙R1,(SP) ˙;SAVE PTR TO TERMINATOR ˙MOV ˙R5,T15(SP) ˙;SAVE PTR TO 0 BYTE GET04: ˙MOV ˙T6(SP),R0 ˙;SEARCH FOR SYMBOL TABLE ENTRY ˙JSR ˙PC,GETSYX ˙;IF FOUND, R2 POINTS TO ENTRY ˙BNE ˙GET06 ˙ ˙;BR IF NO ENTRY FOUND ˙MOV ˙(SP),R1 ˙;RECALL POINTER TO TERMINATOR ˙JSR ˙PC,GEFUN ˙;SHOULD WE DECLARE THIS ITEM ˙ ˙ ˙ ˙;TO BE A FUNCTION? ˙BIC ˙#SGLMKM,SGLWD(R2) ˙;CLEAR SINGLE OCC. BIT ; IF THIS IS THE NAME OF THE Ň ˙PC,OUTSER ˙;A LABEL ˙JSR ˙PC,OUTCOL ˙; FOLLOWED BY A COLON ˙JSR ˙PC,EOL ˙MOV ˙#DOLST,R4 ˙;GET ADDRESS OF DO LIST DO01: ˙CMP ˙R4,#DOEND ˙;OVERFLOW? ˙BHIS ˙DOVF ˙ ˙;YES ˙TST ˙@R4 ˙ ˙;NO, EMPTY ENTRY ˙BEQ ˙DOPUT ˙ ˙;YES , FOUND IT ˙ADD ˙˙#16,R4 ˙ ˙;SKIP OVER ELEMENT ˙BR ˙DO01 ˙ ˙;RE-LOOP TO FIND EMPTY SPACE DOPUT: ˙MOV ˙(R5)+,(R4)+ ˙;NOW ˙MOV ˙(R5)+,(R4)+ ˙;PLACE ˙MOV ˙(R5)+,(R4)+ ˙;THE ˙MOV ˙(R5)+,(R4)+ ˙;TEMPORARY ENTRY ˙MOV ˙(R5)+,(R4)+ ˙;IN PERMANENT ˙MOV ˙(R5)+,(R4)+ ˙;TABLÔFUNCTION WE ARE ; COMPILING, RETURN A FAKE ENTRY ˙MOV ˙SERWD(R2),-(SP) ˙;GET THE SERIAL NUMBER ˙BIC ˙#SERMK,(SP) ˙CMP ˙(SP)+,NAMSER ˙;IS IT THE FUNCTION NAME?? ˙BNE ˙GET07 ˙ ˙;NO ˙MOV ˙#SYMSER,R2 ˙;SUBSTITUTE THE FAKE ENTRY ˙MOV ˙R2,CURSYM ˙;INTO THE POINTER GET07: ˙JSR ˙PC,GETRTR ;SET UP RETURN FROM ENTRY JUST FOUND. GET073: ˙MOV ˙(SP),R1 GET072: ˙MOV ˙T16(SP),R4 ˙;RESTORE R4,R5 ˙MOV ˙T17(SP),R5 ; ;NORMAL EXIT ; GEÖE ˙MOV ˙(R5)+,(R4)+ NODO: ˙RTS ˙PC DOCODE: ˙.ASCII ˙/ ˙$POP2/ ˙.BYTE ˙0 ˙.EVEN FIXP: ˙ADD ˙R5,R4 ˙;COMPUTE ADDRESS OF ITEM ˙MOV ˙@R4,R3 ˙ ˙;GET THE SYMBOL ˙MOV ˙R3,CURSYM ˙;TABLE ADDRESS ˙BR ˙PVAL00 ˙ ˙;GO GET THE PARAMETER PVAL: ˙MOV ˙CURSYM,R3 PVAL00: ˙BIT ˙#PARMKM,PARWD(R3) ˙;IS IT A PARAMETER? ˙BEQ ˙PVAL01 ˙ ˙;NO ˙MOVB ˙PARXWD(R3),R3 ˙;GET THE INDEX ˙BIC ˙#177400,R3 ˙;CLEAR EXTRANEOUS BITS PVAL01: ˙MOV ˙R3,(R4)+ ˙;STORE THE PARAMETER ˙RTS ˙PC ˙.END ŘT071: ˙ADD ˙#T30,SP ˙ ˙;RELEASE TEMPS ˙CLV ˙ ˙ ˙;SET V=0 ˙RTS ˙PC ; GET50A: ˙JMP ˙GET50 ˙;INTERMEDITE HELP ; ; GET06: ˙MOV ˙T18(SP),R0 ˙;ENTRY TYPE IS ALREADY 0 ˙MOVB ˙@T6(SP),T15(SP) ˙;TYPE DATA IMPLICITLY ˙CLRB ˙T15+1(SP) ˙MOV ˙T15(SP),R4 ˙MOVB IMPTAB-101(R4),DATYWD+1(R0) ;REST OF WORD IS 0 ˙MOV MOD40,SYM1WD(R0) ;MOD40 COMPRESSION OF SYMBOL AS ˙MOV ˙MOD40+2,SYM2WD(R0) ; PREPARED IN GETSYM ˙MOV ˙SERIAL,SERWD(R0) ;SERIAL NO. ˙MOV ˙(SP),R1 ˙;GET TEXT POINTER ˙TSTB ˙GETSW ˙ ˙;IFÜ GETSW <> 1 THEN DON'T CHECK FUNCTION ˙BEQ ˙GET08 ˙ ˙;SKIP CHECK ˙JSR ˙PC,CNXC ˙ ˙;GET NEXT NON-BLANK ˙CMPB ˙(R1),#'( ˙;IS IT A LEFT PAREN?? ˙BNE ˙GET08 ˙ ˙;NO ˙BIS ˙#100000,ENTYWD(R0) ;YES, IT CAN'T BE AN ARRAY ˙ ˙ ˙ ˙;OR VARIABLE, SO IT MUST BE ˙ ˙ ˙ ˙;A FUNCTION ;IF ENTRY IS A CONSTANT TRY TO FIND THE SAME CONSTANT ;IN THE SYMBOL TABLE ; GET08: ˙BIT ˙#CONMKM,CONWD(R0) ;IS ENTRY A CONSTANT? ˙BEQ ˙GET081 ˙ ˙;BR IF NOT ˙TSTB ˙NOCNSV ˙ ˙;SHOULD WE SUPPRESS ENTRIES ˙ ˙ ˙ ˙;FOR CONSTAŕNTS? ˙BNE ˙GET082 ˙ ˙;BR IF NOT 0,SUPPRESS ENTRY ˙MOV ˙LENWD(R0),R4 ˙;ELSE SET UP CALLING SEQ TO SYMCON ˙MOV ˙DATYWD(R0),R5 ˙BIC ˙#LENMK,R4 ˙;LENGTH OF CONSTANT ˙MOV ˙T15(SP),R0 ˙;STARTING ADDR OF CONSTANT ˙JSR ˙PC,SYMCON ˙;SEARCH FOR MATCHING ENTRY ˙BVC ˙GET074 ;BR IF MATCH. SYMCON HAS PREPARED ˙ ˙ ;ALL OUTPUTS FOR RETURN GET075: ˙MOV ˙T18(SP),R0 ˙;ELSE, MAKE AN ENTRY ˙MOV ˙T15(SP),R2 GET081: ˙JSR ˙PC,PUTSYM ˙INC ˙SERIAL ˙;UPDATE SERIAL # ˙MOV ˙CURSYM,R2 ˙BR ˙GET07 ;CHECäK IF MATCHING ENTRY MODE MATCHES THAT OF THIS CONSTANT GET074: ˙MOV ˙T18(SP),R5 ˙MOV ˙CURSYM,R4 ˙MOV ˙DATYWD(R5),R5 ˙BIC ˙#DATYMK,R5 ˙MOV ˙DATYWD(R4),R4 ˙BIC ˙#DATYMK,R4 ˙CMP ˙R4,R5 ˙BNE ˙GET075 ˙BR ˙GET073 ;RETURN VALUE AND DESCRIPTIONS OF CONSTANT. ;DO NOT MAKE ENTRY (NOCNSV .NE. 0) GET082:;FAKE AN ENTRY, THEN DELETE IT ˙MOV ˙T18(SP),R0 ˙MOV ˙T15(SP),R2 ˙MOV ˙LSTCHN,-(SP) ˙JSR ˙PC,PUTSYM ˙MOV ˙LSTCHN,SYMCUR ˙MOV ˙(SP)+,R2 ˙MOV ˙R2,LSTCHN ˙MOV ˙CURSYM,R2 GET083: ˙JSčR ˙PC,GETRTR ˙MOV ˙T15(SP),R0 ˙;PTR TO REAL,DOUBLE VALUE ˙BR ˙GET073 ; GET20B: ˙JMP ˙GET20 ˙;INTERMEDIATE HELP GET40: ˙MOV ˙#GELOG,R0 ˙;CHECK FOR .TRUE.,FALSE. ˙JSR ˙PC,SCAN2A ˙BVS ˙GET20B ˙;BR IF NO MATCH ˙MOV ˙GEVAL(R0),T21(SP) ˙;ELSE GET CORRECT VAL. ˙TST ˙T20(SP) ˙BEQ ˙GET401 ˙COM ˙T21(SP) ;SET UP FOR MAKING SYMBOL TABLE ENTRY GET401: ˙MOV ˙R1,T19(SP) ˙;SAVE PTR TO TERM. ˙MOV ˙SP,R2 ˙;COMPUTE & SAVE ADDR OF T2 ˙ADD ˙#T2,R2 ˙MOV ˙R2,T6(SP) ˙MOV ˙IIII,R3 ˙;USE INTEGER SERěIAL # ˙JSR ˙PC,OTOA ˙MOV ˙#"$I,T2(SP) ˙INC ˙IIII ˙MOV ˙T18(SP),R0 ˙BIS ˙#2,LENWD(R0) ˙;LENGTH ˙BIS ˙#004000,DATYWD(R0) ˙;TYPE="LOG-2" ˙JMP ˙GET304 GET50: ˙MOV ˙#1,T25(SP) ;SET SW FOR HOLL CONST DEL. BY ' ; ;ROUTINE TO MAKE A SYMBOL TBL ENTRY ;FOR HOLLERITH CONSTANTS ; GET51: ˙;FIRST MAKE A FIXED LENGTH ENTRY INTO THE SYMBOL TABLE ˙MOV ˙R1,T19(SP) ˙;SAVE PTR TO TERMINATOR ˙MOV ˙SP,R2 ˙;CALCULATE & SAVE ADDR OF T2 ˙ADD ˙#T2,R2 ˙MOV ˙R2,T6(SP) ˙MOV ˙IIII,R3 ˙;USE INTEGER SEIAL #đ ˙JSR ˙PC,OTOA ˙;INTO THE ENTRY IT GOES ˙MOV ˙#"$I,T2(SP) ˙;BEGIN CONSTRUCTING LABEL ˙INC ˙IIII ˙;BUMP SERIAL # ˙MOV ˙T18(SP),R2 ˙;BASE OF SYMBOL BUILD AREA ˙MOV ˙SERIAL,SERWD(R2) ;PUT IN SYMBOL TAB. SERIAL # ˙INC ˙SERIAL ;LENGTH IS STILL 0, DON'T TOUCH IT YET ˙BIS ˙#030000,DATYWD(R2) ˙;SET TYPE FOR HOLL. ;CONVERT SYMBOL TO RAD50 ˙MOV ˙T6(SP),R1 ˙MOV ˙T18(SP),R0 ˙ADD ˙#SYM1WD,R0 ˙JSR ˙PC,PACK00 ;NOW ENTER THE ENTRY THUS FAR CONSTRUCTED ;INTO THE SYMBOL TABLE ˙MOV ˙T18(SP),R0 ˙;ôPTR TO THE ENTRY BUILD AREA ;SAVE VITAL INFO ON SYMBOL TABLE STATUS IN CASE ENTRY ;HAS TO BE DELETED ˙MOV ˙LSTCHN,T22(SP) ˙JSR ˙PC,PUTSYM ;NOW TEST WHICH TYPE OF HOLLERITH CONST. ˙TST ˙T25(SP) ˙BEQ ˙GET55 ˙;BR IF TYPE IS NH... ;ELSE GET HOLL. CONST DELIMITED BY APOSTROPHES (') ˙MOV ˙CURSYM,R5 ˙;BASE OF ENTRY ˙MOV ˙R5,R4 ˙ADD ˙#VALUE,R4 ˙;BEGINNING OF APPEND AREA ˙MOV ˙T19(SP),R1 ˙;RECALL PTR TO INPUT ˙TSTB ˙(R1)+ ˙;BUMP PTR PAST 1ST DELIMITER GET512: ˙CMPB ˙(R1),#'' ˙;IS CURR. CH ANř APOSTROPHE? ˙BEQ ˙GET511 ˙;BR IF YES ˙JSR ˙PC,CON03 ˙;ELSE IS THERE ROOM FOR THIS CH? GET517: ˙INCB ˙LENWD(R5) ˙;BUMP CH COUNT ˙MOVB ˙(R1)+,(R4)+ ˙;IF RETURN, YES, MOVE IT IN ˙BNE ˙GET512 ˙;DID WE MOVE AN E.O.L. (0)? GET518: ˙TRAP+78. ˙;HOLL CONSTRUCTION INCOMPLETE ˙DEC ˙LENWD(R5) ˙;DONT INCLUDE E.O.L. IN COUNT ˙DEC ˙R1 ˙;BACK UP PTR ˙DEC ˙R4 ˙;BACK UP DEST FLD GET516: ˙RORB ˙LENWD(R5) ˙;YES.DO WE HAVE AN ODD COUNT? ˙BCC ˙GET515 ˙;BR IF NOT ODD ˙MOVB ˙#' ,(R4)+ ;PAD AND MAKE R4 EVEN üAT NXT WRD GET515: ˙ROLB ˙LENWD(R5) ˙CLR ˙(R4)+ ˙;TERMINATE CONST. WITH 0 ˙MOV ˙R4,SYMNXT ˙;UPDATE PTR TO FREE SYM TBL SPACE ;NOW GET READY TO RETURN INFORMATION TO THE CALLING PROGRAM. ˙TSTB ˙NOCNSV ˙;SHOULD WE SUPPRESS ENTRIES FOR CONST? ˙˙BNE ˙GET513 ˙;BR IF YES ˙MOV ˙R5,R2 ˙;ELSE RETURN ENTRY + INDICATORS ˙BIS ˙#CONMKM,CONWD(R5) ˙;SET CONST. IND ˙JSR ˙PC,GETRTR GET514: ˙JMP ˙GET072 GET513: ˙MOV ˙LSTCHN,SYMCUR ˙MOV ˙T22(SP),R2 ˙MOV ˙R2,LSTCHN ˙ ˙ ˙ ˙;WHEN THE ENTRY WAS MADE ˙ ˙ ˙ ˙;(I.E., DELETE THE ENTRY) ˙MOV ˙#6,R2 ˙;DATA TYPE= "HOLLERITH" ˙MOV ˙#-1,R3 ˙BR ˙GET514 ˙;EXIT ; GET511: ˙CMPB ˙1(R1),#'' ˙;IS THIS APOSTROPHE FOLLOWED ˙ ˙ ˙;BY ANOTHER? ˙BNE ˙GET519 ˙;IF NOT, END OF CONSTANT ˙TSTB ˙(R1)+ ˙;ELSE PASS ONE APOSTROPHE ON ˙BR ˙GET517 GET519: ˙INC ˙R1 ˙;STEP PAST FINAL DELIMITER ˙BR ˙GET516 ; ;COLLECT HOLL. CONSTANT TYPE NH... ; GET55: ˙MOV ˙T19(SP),R1 ˙;RECALL PTR TO INPUT ˙MOV ˙(SP),R3 ˙;VALUES OF INTEGER N (COUNT) ˙TSTB ˙(R1)+ ˙;STEP PAST H  ˙MOV ˙CURSYM,R5 ˙;GET BASE OF ENTRY ˙MOV ˙R5,R4 ˙;GET BASE OF VALUE ˙ADD ˙#VALUE,R4 ˙MOVB ˙R3,LENWD(R5) ˙;PUT COUNT IN ENTRY GET551: ˙MOVB ˙(R1)+,(R4)+ ˙;GET NEXT CH. ˙BEQ ˙GET552 ˙;WAS IT E.O.L? ˙DEC ˙R3 ˙;IF NOT, REDUCE COUNT ˙BNE ˙GET551 ˙;BR IF NOT DONE ˙BR ˙GET516 ˙;DONE GET552: ˙SUB ˙R3,LENWD(R5) ˙;ADJUST COUNT FOR SHORT CONST. ˙TRAP+78. ˙;***HOLL CONST TERMINATED BY E.O.L. ˙DEC ˙R4 ˙;BACK UP R4 POINTER ˙BR ˙GET516 GET20: ˙;EXAMINE INPUT FOR A CONSTANT. ˙CLR ˙(SP) ˙ ˙;T1=WIDTH ˙CLR ˙T2(SP) ˙ ˙;T2=# DIG TO RT OF POINT ˙CLR ˙T3(SP) ˙ ˙;T3=E OR D OR 0 ˙MOV ˙#1,T4(SP) ˙;T4=1 MEANS THIS IS AN INTEGER ˙CLR ˙T6(SP) ˙ ˙;T6=PERIOD FOUND SW. ˙MOV ˙SYMCUR,R4 ;PROVIDE SPACE FOR COPYING CONSTANT ˙MOV ˙R4,T5(SP) ˙;SAVE POINTER FOR LATER. ˙JSR PC,CONINT ;CONVERT AS MUCH AS POSS. TO INTG. BINARY. ˙BVS ˙GET201 ˙;SAVE OVERFLOW INDICATOR (V) IN T15 ˙CLR ˙T15(SP) ˙ ˙;V=0, SET T15=0 ˙BR ˙GET202 GET201: ˙MOV ˙#1,T15(SP) ˙;V=1, SET T15=1 GET202: ˙MOV T5(SP),R5 ;COMPUTE # DIGITS SEEN, ADD TO WIDTH ˙MOV ˙R4,T5(SP) ;SAVE POINTER TO CONST. BUILD AREA ˙SUB ˙R5,R4 ˙ADD ˙R4,(SP) ˙JSR ˙PC,CHTEST ˙;TYPE OF TERMINATOR- ˙BCS ˙GET21 ˙ ˙;BR IF SPECIAL CHARACTER. GET23: CMPB (R1),#'H ;ELSE, MUST BE A LETTER. (DIG. CAN'T STOP CONINT) ˙BEQ ˙GET25 ˙ ˙;BR IF H (HOLL CONST) ˙BR ˙GET35 GET24: ˙TRAP+13. ˙ ˙ ˙;ILLEGAL FORMAT ˙JMP ˙GET09 GET21: ˙CMPB ˙(R1),#'. ˙;CHECK TERMINATOR=. ˙BEQ ˙GET22 ˙;BR IF YES (CHECK FOR SPECIAL CASE) GET35: ˙TST ˙T15(SP) ˙ ˙;WAS INTEGER TOO BIG? ˙BNE ˙GET36 ˙ ˙;BR IF YES ;ELSE BEGIN CONSTRUCTING A SYMBOL TABLE ENTRY ; FOR THIS INTEGER CONSTANT GET361: ˙TSTB ˙GETSW ˙;SHOULD WE MAKE AN ENTRY FOR THIS ˙BEQ ˙GET365 ˙;BR IF NO ˙TST ˙T20(SP) ˙BEQ ˙GETN2 ˙NEG ˙R3 GETN2: ˙MOV ˙R3,(SP) ˙ ˙;SAVE VALUE OF INTEGER IN T1. ˙MOV ˙R1,T19(SP) ˙;SAVE PTR TO TERMINATOR ˙;CONSTRUCT A SYMBOL FOR THIS CONSTANT: ˙MOV ˙SP,R2 ˙ ˙;COMPUTE AND SAVE ADDR OF T2 ˙ADD ˙#T2,R2 ˙MOV ˙R2,T6(SP) ˙MOV ˙IIII,R3 ˙ ˙;CONVERT SERIAL TO ASCII AND ˙JSR ˙PC,OTOA ˙ ˙;THEN PREFIX (CLOBBER 1ST ˙MOV ˙#"$I,T2(SP) ˙;2 DIGITS) $I TO IT. ˙INC ˙IIII ˙ ˙;BUMP SERIAL NO. FOR NEXT USE ˙;ENTRY TYPE IS ALREADY 0 ˙MOV ˙T18(SP),R0 ˙;GET BASE OF ENTRY BUILD AREA ˙BIS ˙#010000,DATYWD(R0) ˙;SET TYPE TO INTEGER ˙BIS ˙#2,LENWD(R0) ˙;COUNT=2 ˙BIS ˙#CONMKM,CONWD(R0) ˙;CONSTANT BIT ˙MOV ˙SERIAL,R4 ˙;PUT IN CURR SER. # ˙BIC ˙#SERMK,R4 ˙BIS ˙R4,SERWD(R0) ˙TST ˙T15(SP) ˙ ˙;CHECK VALUE OF INTEGER. ˙BEQ ˙GET351 ˙ ˙;NO OVERFLOW,BR ˙MOV #77777,(SP) ;ELSE SUBSTITUTE BIG #, ISSUE DIAGN. ˙TRAP+14. ;INTEGER CONSTANT LARGER THAN ADMISSABLE ˙BR ˙GET351 ;NO SYMBOL ENTRY TO BE MADE--INTEGER CONSTANT. ;RETURN VALUE INSTEAD OF SERIAL # GET365: ˙MOV ˙R3,R0 ˙;PUT VAL IN R0 ˙MOV ˙#2,R2 ˙;TYPE=INTEGER ˙MOV ˙#-1,R3 ˙;ITEM WAS A CONST. ˙JMP ˙GET072 ; GET351: ˙MOV ˙T19(SP),T26(SP) ˙;SAVE T19 IN A TEMP ˙MOV ˙(SP),T21(SP) ˙;MOVE VALUE TO CORRECT PLACE GET352: ˙MOV ˙T6(SP),R1 ˙;ADDR OF INPUT TO PACK00 ˙ADD ˙#SYM1WD,R0 ˙;ADDR OF OUTPUT OF PACK00 ˙JSR ˙PC,PACK00 ˙MOV ˙T18(SP),R0 ˙MOV ˙R0,R2 ˙ADD ˙#VALUE,R2 GET353: ˙MOV ˙T26(SP),(SP) ˙;PUT ADDR OF TERM. IN ˙ ˙ ˙ ˙;RIGHT PLACE FOR EXIT ˙MOV ˙SP,T15(SP) ˙;SET UP ADDR OF INTEG. ˙ADD ˙˙#T21,T15(SP) ˙;INTEGER ˙JMP ˙GET08 ˙ ˙;BR TO ENTER SYMBOL, THEN RETURN GET359: ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R1 ˙;TAIL END OF CODE AT GET22 ˙BR ˙GET35 GET36: ˙TRAP+15. ˙ ˙;OVERFLOW ON IN TEGER CONVERSION ˙MOV ˙#077777,R3 ˙BR ˙GET361 ; ; GT222A: ˙JMP ˙GET222 ˙;INTERMEDIATE HELP ; ; ; GET25: ˙CLR ˙T25(SP) ˙;SET SW FOR HOLL. CONST, NH... ˙MOV ˙R3,(SP) ˙;SAVE VALUE OF COUNT ˙JMP ˙GET51 GET22: ˙;TEST FOR A RELATIONAL OPERATOR FOLLOWING INTEGER CONST ˙MOV ˙R1,-(SP) ˙MOV ˙R3,-(SP) ˙MOV ˙#LOGREL,R0 ˙JSR ˙PC,SCAN2A ˙;CHECK FOR ".LT.",".LE.",ETC. ˙BVC ˙GET359 ˙;BR IF A REL. OP. FOLLOWS (CONST. ˙ ˙ ˙;IS AN INTEGER ˙MOV ˙(SP)+,R3 ˙MOV ˙(SP)+,R1 ˙;ELSE CONST. IS FLOATIN$G ˙MOV ˙T5(SP),R4 ˙;RECALL PTR TO BUILD AREA ˙JSR ˙PC,CON03 ˙;CHECK THAT CH FITS--- ˙MOVB ˙(R1),(R4)+ ˙;DEPOSIT DEC. PT IN BUILD AREA ˙JSR ˙PC,CNXC1 ˙;GET NXT NON BLANK ˙INC ˙(SP) ˙ ˙;BUMP WIDTH BY 1 ˙MOV R4,T5(SP) ˙;SAVE PTR TO BUILD AREA ˙JSR ˙PC,CONINT ˙;GET FRACTIONAL PART OF CONSTANT ˙MOV ˙T5(SP),R5 ˙;COMPUTE # DIGITS IN FRAC.PRT ˙MOV ˙R4,T5(SP) ˙SUB ˙R5,R4 ˙ADD ˙R4,(SP) ˙ ˙;ADD TO WIDTH ˙MOV ˙R4,T2(SP) ˙;RETAIN FOR # DEC PLACES ˙CMPB ˙(R1),#'E ˙;WAS TERM. AN E OR D? ˙BEQ (˙GET27 ˙ ˙;BR IF YES ˙CMPB ˙(R1),#'D ˙BNE ˙GT222A ˙ ˙;BR IF NO GET27: ˙MOVB ˙(R1),T3(SP) ˙;ELSE SAVE TERM. (E OR D) ˙MOV ˙T5(SP),R4 ˙JSR ˙PC,CON03 ˙MOVB ˙(R1),(R4)+ ˙;PUT TERM. IN BUILD AREA GET31: ˙INC ˙(SP) ˙ ˙;INCR. WIDTH ˙JSR ˙PC,CNXC1 ˙;GET NEXT NON BLANK ˙CMPB ˙(R1),#'+ ˙;IS IT A + OR -? ˙BEQ ˙GET33 ˙ ˙;BR IF + ˙CMPB ˙(R1),#'- ˙BEQ ˙GET33 ˙ ˙;BR IF - ;ELSE EXPONENT, IF ANY, IS UNSIGNED GET311: ˙MOV ˙R4,T5(SP) ˙;GET EXPONENT, IF ANY ˙JSR ˙PC,CONINT ˙MOV ˙T5(SP),R5 ˙;COMPUT,E # DIGITS IN EXPONENT ˙MOV ˙R4,T5(SP) ˙SUB ˙R5,R4 ˙ADD ˙R4,(SP) ˙ ˙;ADD TO WIDTH GET30: ˙MOV SYMCUR,-(SP) ;PUSH PARAM'S ONTO STACK - START OF FIELD ˙MOV ˙2(SP),-(SP) ˙;WIDTH ˙MOV ˙T2+4(SP),-(SP) ˙;D PART OF W.D ˙CLR ˙-(SP) ˙;SCALE FACTOR (P), =0 ˙CMP ˙T3+10(SP),#'E ˙;IS THIS AN E CONVERSION? ˙BNE ˙GET301 ˙;BR IF NOT, ASSUME D ˙JSR ˙PC,$RCI ˙MOV ˙(SP)+,T21+2(SP) ˙;UNLOAD RESULT, FIX UP STACK ˙MOV ˙(SP)+,T22(SP) ˙TST ˙T20(SP) ˙BEQ ˙GET302 ˙ADD ˙#100000,T21(SP) ˙;REVERSE SIGN G0ET302: ˙MOV ˙SP,T15(SP) ˙;COMPUTE ADDR OF T21, THE CONST ˙ADD ˙#T21,T15(SP) ;NOW CONSTRUCT THE ACTUAL ENTRY ˙MOV ˙R1,T19(SP) ˙;SAVE PTR TO TERMINATOR ˙MOV ˙SP,R2 ˙ ˙;COMPUTE & SAVE ADDR OF T2 ˙ADD ˙#T2,R2 ˙MOV ˙R2,T6(SP) ˙CMP ˙T3(SP),#'D ˙;IS THIS DOUBLE PREC.? ˙BEQ ˙GET303 ˙;BR IF YES ˙MOV ˙RRRR,R3 ˙ ˙;CONSTRUCT SYMBOL FOR CONSTANT ˙JSR ˙PC,OTOA ˙MOV ˙#"$R,T2(SP) ˙INC ˙RRRR ˙ ˙;BUMP SEIAL # FOR NXT USE ˙MOV ˙T18(SP),R0 ˙;BASE OF ENTRY BUILD AREA ˙BIS ˙#014000,DATYWD(R0) ;SET TY4PE TO REAL ˙BIS ˙#4,LENWD(R0) ˙;SIZE=4 GET304: ˙BIS ˙#CONMKM,CONWD(R0) ;CONSTANT BIT ˙MOV ˙SERIAL,R4 ˙;PUT IN CURR. SER # ˙BIC ˙#SERMK,R4 ˙BIS ˙R4,SERWD(R0) ˙MOV ˙T6(SP),R1 ˙;SET UP CLG SEQ TO PACK00 ˙ADD ˙#SYM1WD,R0 ˙JSR ˙PC,PACK00 ˙;DO RAD50 PACK INTO ENTRY ˙MOV ˙T18(SP),R0 ˙MOV ˙T15(SP),R2 ˙MOV ˙T19(SP),T26(SP) ˙;SHUFFLE AROUND SAVED R1 ˙JMP ˙GET353 GET301: ˙JSR ˙PC,$DCI ˙;CONVERT DOUBLE PREC. ;UNLOAD DOUBLE PREC RESULT ˙MOV ˙(SP)+,T21+6(SP) ˙MOV ˙(SP)+,T22+4(SP) ˙MOV ˙(S8P)+,T23+2(SP) ˙MOV ˙(SP)+,T24(SP) ˙TST ˙T20(SP) ˙BEQ ˙GET302 ˙ADD ˙#100000,T21(SP) ˙;REVERSE SIGN ˙BR ˙GET302 ; GET222: ˙MOV ˙#'E,T3(SP) ˙;CONSTANTIS REAL ˙BR ˙GET30 GET33: ˙JSR ˙PC,CON03 ˙;PUT SYM IN BUILD AREA ˙MOVB ˙(R1),(R4)+ ˙INC ˙(SP) ˙;BUMP WIDTH ˙JSR ˙PC,CNXC1 ˙;GET NEXT NONBLANK ˙BR ˙GET311 ; ;SPECIALIZED CODE FOR SETTING UP DOUBLE PREC CONST GET303: ˙MOV ˙DDDD,R3 ˙JSR ˙PC,OTOA ˙MOV ˙#"$D,T2(SP) ˙INC ˙DDDD ˙MOV ˙T18(SP),R0 ˙BIS ˙#020000,DATYWD(R0) ˙BIS ˙#10,L<ENWD(R0) ˙BR ˙GET304 ; ; ; ; ;GETRTR ; ˙CALL- ˙JSR ˙PC,GETRTR ; ˙INPUT- ˙R2 POINTS TO THE SYMBOL TABLE ENTRY. ; ˙OUTPUT- ˙ALL OUTPUTS OF "GET" ARE TAKEN FROM THE ENTRY ; ˙ ˙AND PUT IN THE CORRECT PLACES, EXCEPT V & R1. ; GETRTR: ˙MOV ˙SERWD(R2),R0 ˙;GET SERIAL NUMBER OF ITEM ˙BIC ˙#SERMK,R0 ˙CLR ˙R3 ˙;ASSUME SIMPLE VARIABLE FOR NOW ˙BIT ˙#ENTYMM,ENTYWD(R2) ; IS IT AN FUNCTION? ˙BNE ˙GETR04 ˙ ˙;YES ˙BIT ˙#CONMKM,CONWD(R2) ;IS CONSTANT BIT ON? ˙BNE ˙GETR02 ˙ ˙;BR IF YES ˙BIT ˙#DIM@MKM,DIMWD(R2) ;ELSE, IS DIMENSION NOT EQ 0? ˙BNE ˙GETR03 ˙ ˙;BR IF NOT 0 (IE, IF DIMENSIONED) ˙CLR ˙R3 ˙ ˙;ITEM IS A SIMPLE VARIABLE. ˙BR ˙GETR10 GETR02: ˙DEC ˙R3 ˙ ˙;ITEM IS A CONSTANT ˙BR ˙GETR10 GETR03: ˙INC ˙R3 ˙ ˙;ITEM IS AN ARRAY NAME ˙BR ˙GETR10 GETR04: ˙MOV ˙#2,R3 ˙ ˙;ITEM IS A FUCNTION NAME GETR10: ˙MOV ˙DATYWD(R2),R2 ˙;GET DATA TYPE ˙BIC ˙#DATYMK,R2 ˙;MASK OUT FIELD ˙CCC ˙ ˙ ˙;SHIFT INTO LOW ORDER OF R2 ˙SWAB ˙R2 ˙ASR ˙R2 ˙ASR ˙R2 ˙ASR ˙R2 ˙RTS ˙PC ˙ ˙;RETURN D; ;ALTERNATE ENTRY TO GETSYM ;SUPPRESSES CLEARING THE SINGLE OCCURRENCE BIT ;IF THE ITEM IS FOUND. GETSYX: ˙MOV ˙#1,-(SP) ˙;SET FLAG ON STACK ˙BR ˙GETCOM ; ; ; ;GETSYM ˙ATTEMPTS TO LOCATE A SYMBOL TABLE ENTRY, GIVEN THE SYMBOL ;ON ENTRY: (R0)=1ST BYTE OF UNPACKED SYMBOL ; ˙SYMBOL TERMINATED BY A BYTE=0 ;MAX OF 6 CHARACTERS ;ON RETURN (R0),(R1) ˙CLOBBERED ; ˙ (R2)=1ST WORD OF ENTRY (IF ONE EXISTED) ; ˙ ˙Z=1 IF THERE WAS AN ENTRY. H;CALL: ˙JSR ˙PC,GETSYM GETSYM: ˙CLR ˙-(SP) ˙ ˙;CLEAR FLAG GETCOM: ˙MOV ˙LSTCHN,R5 ˙;GET THE TABLE ADDRESS GETSY5: ˙MOV ˙R0,R1 ˙ ˙;CONVERT ˙MOV ˙#MOD40,R0 ˙; THE NAME ˙MOV ˙R5,-(SP) ˙JSR ˙PC,PACK00 ˙; TO PACKED FORM ˙MOV ˙(SP)+,R5 GETSY1: ˙MOV ˙R5,R2 ˙ ˙;REMEMBER START OF ENTRY ˙BEQ ˙GETSY4 ˙ ˙;EXIT IF TABLE EMPTY ˙MOV ˙#MOD40+4,R0 ˙;GET ADDRESS OF NAME ˙ADD ˙#SYM2WD+2,R5 ˙;POINT TO DATA ITEMS ˙CMP ˙-(R5),-(R0) ˙;IS THIS WHAT WE WANT?? ˙BNE ˙GETSY2 ˙ ˙;NO ˙CMP ˙-(R5),-(R0) ˙;LOOK ALT NAME AGAIN ˙BNE ˙GETSY3 ˙ ˙;NO MATCH ˙MOV ˙R2,CURSYM ˙;SET POINTER TO ITEM ˙TST ˙(SP)+ ˙ ˙;CLEAR SINGLE REF. BIT?? ˙BNE ˙GETEX ˙ ˙;NO ˙BIC ˙#SGLMKM,SGLWD(R2) ;CLEAR THE SINGLE REF. GETEX: ˙SEZ ˙ ˙ ˙;SET ZERO ˙RTS ˙PC ˙ ˙;AND RETURN GETSY2: ˙TST ˙-(R5) ˙ ˙;SKIP THE NAME GETSY3: ˙MOV ˙-(R5),R5 ˙;GET ADDRESS ˙BMI ˙GETSY4 ˙ ˙;EXIT IF END OF LIST ˙ADD ˙SYMBAS,R5 ˙;OF THE NEXT ELEMENT ˙BR ˙GETSY1 ˙ ˙;RE-LOOP GETSY4: ˙TST ˙(SP)+ ˙ ˙;POP JUNK ˙CLZ ˙ ˙ ˙;SET NON-ZERO ˙RTS ˙PC ˙ ˙ ˙;AND PRETURN ; ;MOVE ROUTINE. #WORDS IS IN R5, SOURCE BLOCK ;IS R3, DESTINATION BLOCK IS IN R4. THEY WILL POINT TO NEXT ; ˙AVAILABLE WORDS ON EXIT ;CALL: ˙JSR ˙PC,MOVE ; MOVE: ˙TST ˙R5 ˙;0 WORDS? ˙BEQ ˙MOVE01 ˙;BR IF NO MOVE ˙MOV ˙(R3)+,(R4)+ ˙;ELSE MOVE 1 WORD ˙DEC ˙R5 ˙ ˙;DECREMENT WORD COUNT ˙BR ˙MOVE ˙ ˙;LOOP BACK MOVE01: ˙RTS ˙PC ˙ ˙;EXIT ; ;GEFUN-- ;INPUTS -T - R1 POINTS TO TERMINATING CH OFITEM ;CURSYM POINTS TO SYMB TBL ENTRY FOR ITEM ;LOGIC - - IF ALL OF THE FOLLOWING CONDITIONS ARE TRUE ;THEN THE V BIT IS SET. ELSE IT CLEARED: ;A. THIS IS AN EXECUTABLE STATEMENT ;B. THIS ITEM HAS BEEN REFERRED TO EXACTLY ONCE BEFORE ;C. THIS VARIABLE APPEARED IN A TYPE STATEMENT ;D. A LEFT PARENTHESIS FOLLOWS THE VARIABLE NAME ;E. THIS VARIABLE HAS NOT BEEN DIMENSIONED ; ;V=1 => THIS VARIABLE SHOULD BE DECLARED TO BE A FUNCTION NAME ;V=0 => THIS VARIABLE SXHOULD LEFT AS IT NOW IS ; GEFUN: ˙TSTB ˙GETSW ˙BEQ ˙GEFUN1 ˙;BR IF NOT AN EXECUTABLE STATEMENT ˙BIT ˙#SGLMKM,SGLWD(R2) ;BR IF ITEM WAS REFERRED ˙ ˙;TO PREVIOUSLY ˙BEQ ˙GEFUN1 ˙BIC ˙#SGLMKM,SGLWD(R2) ˙;PARENTHETICALLY, ˙ ˙ ˙;CLEAR THE SINGLE OCCUR. BIT ˙BIT ˙#EXPMKM,EXPWD(R2) ˙BEQ ˙GEFUN1 ˙;BR IF ITEM NOT EXPLICITLY TYPED ˙JSR ˙PC,CNXC ˙;GET NEXT NON BLANK CH. ˙CMPB ˙(R1),#'( ˙BNE ˙GEFUN1 ˙;BR IF NO "(" FOLLOWS ˙BIT ˙#DIMMKM,DIMWD(R2) ;ANY DIMENSIONING BITS ON? ˙BNE ˙GEFUN1 ˙;BR\ IF DIMENSIONED ˙BIS ˙#100000,ENTYWD(R2) ˙;SET FUNCTION BIT GEFUN1: ˙RTS ˙PC ; ; ;PUTSYM PUTS AN ENTRY IN THE SYMBOL TABLE ;CALLED BY: JSR ˙PC,PUTSYM ; ˙(R0)=1ST WORD OF FIXED PORTION OF THE NEW ENTRY. ; ˙(R2)=1ST BYTE OF VALUE OF CONSTANT, IF ANY. ;(CURHSH)=6-BIT HASH OF SYMBOL PACKED INTO THIS ENTRY ;OUTPUT: ˙(CURSYM)=ADDR. OF ENTRY CREATED PUTSYM: ˙MOV ˙R1,-(SP) ˙;SAVE R1 ˙MOV ˙#SYMSIZ,R5 ˙;GET BASIC ENTRY LENGTH ˙CLR ˙R1 ˙ ˙;SET CONSTANT LENGTH TO ZERO ˙BIT ˙#CONMKM,CONWD(R0) ;IS T`HERE A CONSTANT? ˙BEQ ˙PUTS01 ˙ ˙;NO ˙MOVB ˙LENWD(R0),R1 ˙;GET LENGTH ˙BIC ˙#LENMK,R1 ˙;CLEAR JUNK BITS ˙INC ˙R1 ˙ ˙;GET LENGTH IN ˙ASR ˙R1 ˙ ˙;WORDS ROUNDED UP TO NEXT COUNT PUTS01: ˙MOV ˙R5,-(SP) ˙;REMEMBER BASIC LENGTH ˙ADD ˙R1,R5 ˙ ˙;GET TOTAL LENGTH ˙ADD ˙SYMNXT,R5 ˙;GET ENDING ADDRESS ˙CMP ˙R5,SYMEND ˙;WILL IT FIT?? ˙BHIS ˙PUTS04 ˙ ˙;NO ˙MOV ˙SYMNXT,R4 ˙;GET ADDRESS OF DESTINATION ˙MOV ˙R0,R3 ˙ ˙;GET ADDRESS OF SOURCE ˙MOV ˙(SP)+,R5 ˙;AND COUNT ˙JSR ˙PC,MOVE ˙ ˙;MOVE THE BdASIC ˙MOV ˙R2,R3 ˙ ˙;ENTRY, NOW GET CONSTANT ADDRESS ˙MOV ˙R1,R5 ˙ ˙;SET UP THE COUNT ˙BEQ ˙PUTS02 ˙ ˙;NOTHING TO MOVE IF ZERO ˙JSR ˙PC,MOVE ˙ ˙;MOVE THE VALUE PUTS02: ˙MOV ˙SYMNXT,R1 ˙;GET ˙MOV ˙#-1,NXSYWD(R1) ˙;CLEAR THE NEW LINK ˙MOV ˙˙LSTCHN,R0 ˙;GET POINTER TO PREVIOUS ENTRY ˙BEQ ˙PUTS03 ˙ ˙;NO PREVIOUS ENTRY ˙SUB ˙SYMBAS,R0 ˙;CONVERT TO DISPLACEMENT ˙MOV ˙R0,NXSYWD(R1) ˙;STORE THE POINTER TO THE NEXT PUTS03: ˙MOV ˙SYMNXT,R1 ˙;SET ˙MOV ˙R1,CURSYM ˙; UP ˙MOV ˙R1,LSTCHN ˙; CURSYhM AND LSTCHN ˙MOV ˙R4,SYMNXT ˙;NOW RESET THE END POINTER ˙BIS ˙#SGLMKM,SGLWD(R1) ;SET "SINGLE OCCURRENCE" ˙MOV ˙(SP)+,R1 ˙;RESTORE R1 ˙RTS ˙PC PUTS04: ˙MOV ˙2(SP),R1 ˙;SET FAKE R1 ˙TRAP+5. ˙ ˙ ˙;SYMBOL TABLE FULL ˙MOV ˙LOW,SP ˙ ˙;ABORT ˙JMP ˙SCANNR ˙ ˙;THE STATEMENT ; ; ; SYMCON - FIND A SYMBOL TABLE ENTRY WHOSE CONSTANT ; ˙VALUE = INPUT VALUE ; ; ˙INPUT R0=PTR TO CONSTANT ; ˙ ˙R4=LENGTH OF CONSTANT IN BYTES ; ˙ ˙R5=MODE OF CONSTANT (BITS 13-11) ; ˙ ˙ (OTHER BITS WILL BE IGNORED) l ; ; OUTPUT - V=0, ENTRY FOUND ; ˙V=1, NO ENTRY FOUND ; ˙CURSYM=ADDRESS OF FOUND ENTRY ; ˙R2, R3 = SAME AS SERATR ; SYMCON: ˙MOV ˙R1,-(SP) ˙MOV ˙R5,-(SP) ˙MOV ˙R4,-(SP) ˙MOV ˙#1,-(SP) ˙BR ˙SYM01 ; ;SERATR ; ˙INPUT: ˙(R0)=SERIAL # ;PRIN. OUTPUT -- ˙(CURSYM)=FOUND ENTRY. ; ˙OUTPUTS: ˙(R2)=DATA TYPE OF DATUM ; ˙ ˙(R3)=-1, CONSTANT ; ˙ ˙ =0, VARIABLE ; ˙ ˙ =1, ARRAY NAME ; ˙ ˙ =2, FUNCTION NAME ; ˙ ˙V=0,p NORMAL RETURN ; ˙ ˙V=1, SYSTEM ERROR, ENTRY SERATR: ˙MOV ˙R1,-(SP) ˙MOV ˙R5,-(SP) ˙MOV ˙R4,-(SP) ˙CLR ˙-(SP) ; IS THIS THE SERIAL NUMBER OF THE FUNCTION WE ARE COMPILING? SYM01: ˙CMP ˙R0,NAMSER ˙BEQ ˙SER08 ˙ ˙;JUMP IF YES ˙MOV ˙LSTCHN,R3 ˙;START OF TABLE ˙BEQ ˙SER01 ˙;QUIT IF TABLE EMPTY ˙BR ˙SER04 SER05: ˙ADD ˙SYMBAS,R3 ˙;GET REAL TABLE START SER04: ˙TST ˙(SP) ˙ ˙;WHICH ENTRY IS THIS ˙BEQ ˙SER06 ˙ ˙;SERATR ˙MOV ˙4(SP),R5 ˙;(INPUT TO CONCOM) ˙JSR ˙PC,CONCOM ˙;ELSE, SYMCON ˙BR t˙SER07 SER06: ˙MOV ˙SERWD(R3),-(SP) ˙BIC ˙#SERMK,@SP ˙CMP ˙(SP)+,R0 ˙;CURRENT ITEM A HIT? SER07: ˙BEQ ˙SER03 ˙ ˙;IF YES, RETURN NORMALLY ˙MOV ˙NXSYWD(R3),R3 ˙;ELSE IS THIS LAST ENTRY IN CHAIN ˙BPL ˙SER05 ˙ ;IF NOT MAKE ABSOLUTE & LOOP BACK SER01: ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R4 ˙MOV ˙(SP)+,R5 ˙MOV ˙(SP)+,R1 ˙SEV ˙RTS ˙PC SER08: ˙MOV ˙#SYMSER,R3 ˙;GET ADDRESS OF FAKE ENTRY SER03: ˙MOV ˙R3,R2 ˙ ˙;NORMAL RETURN ˙MOV ˙R3,CURSYM SER09: ˙JSR ˙PC,GETRTR ˙TST ˙(SP)+ ˙MOV ˙(SP)+,R4 ˙MOVx ˙(SP)+,R5 ˙MOV ˙(SP)+,R1 ˙CLV ˙RTS ˙PC ; ;TABLE OF LOGICAL CONSTANTS AND VALUES ;FORMAT IS DESIGNED FOR USE BY "SCAN2A" ; GELO0: ˙.ASCII ˙/.TRUE./ GELO1: ˙.ASCII ˙/.FALSE./ GELO2=. ˙.EVEN GELOG: ˙GELO0 ˙GELO1 ˙GELO2 ˙0 ; ;TABLE OF LOGICAL VALUES; ; GEVAL: ˙-1 ˙;TRUE ˙0 ˙;FALSE ; ; .END ;