.TITLE MACFTN .IDENT /0601/ ;COPYRIGHT 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; ;SELECT FORTRAN ASSEMBLY OPTION ; XFTN = 1 .IF DF XFTN XMACRO = 1 .MCALL .CLOSE,.DELET,.INIT,.OPEN,.READ,.RLSE,.WAIT,.WRITE .ENDC R0= %0 R1= %1 R2= %2 R3= %3 R4= %4 R5= %5 SP= %6 PC= %7 .CSECT ;INIT SECTIONS .CSECT IMPURE ;IMPURE STORAGE AREA IMPURE: .CSECT IMPPAS ;CLEARED EACH PASS IMPPAS: .CSECT IMPLIN ;CLEARED EACH LINE IMPLIN: .CSECT MIXED ;MIXED MODE SECTOR .CSEC .TITLE MSSIO ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL BITM,GET,GENLAB,OUTTAB,OUTSER,EOL .GLOBL OUTLN1,NXTCH,MISC,CURSYM,PSHMKM,PSHWD .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11 ; ; REWIND, BACKSPACE, ENDFILE ; .GLOBL REWIND,BACKSP,ENDFIL .GLOBL ZLEQLS REWIND: JSR PC,ZLEQLS ;CAN T .TITLE OPTTAB .IDENT /0605/ ; ; IMPURE WORK AREA FOR "OPTIMIZED POLISH" ; ; COPYRIGHT 1972,1973, DIGITAL EQUIPMENT CORP ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY R.BRENDER ; .PSECT ZZZHGH .GLOBL STK,STKPTR,STKBEG,STKEND,STKSIZ .GLOBL STKRBS,STKDTH STKSIZ =100. STK: .BLKB STKSIZ+4 STKPTR: 0 STKBEG: 0 STKEND: 0 STKRBS: 0 STKDTH: 0 ; .GLOBL POLPTR,WORKI,TEXTR1 POLPTR: 0 WORKI: 0 TEX .TITLE OUTSL ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL OUTSL,CNXC,CHTEST,OUTCHR ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ; OUTPUT A STATEMENT LABEL TO OBJECT DEVICE ; R1 POINTS TO INPUT TEXT ; LENGTH CHECKS, ETC., ARE PERFORMED ; V=0 => ALL OK ; V=1 => NOT OK ; OUTSL: MOV R2,-(SP) ;SAVE R2 OUTSL T ;UNNAMED IS STANDARD .GLOBL PSTBAS, PSTTOP ;PERM SYMBOL TABLE .GLOBL WRDSYM ;".WORD" DEFAULT .IF NDF XFTN HELLO: .ASCIZ /MACROV-11 V747 / ;INTRO MESSAGE .EVEN .ENDC .IF DF XFTN .GLOBL OPCL01,OPCL02,OPCL03,OPCL04,OPCL05 OPCL01=1 OPCL02=2 OPCL03=3 OPCL04=4 OPCL05=5 .ENDC .SBTTL SUBROUTINE CALL DEFINITIONS .MACRO GENCAL NAME ;CAN BE CHANGED TO OPDEFS OR TRAPS .MACRO NAME JSR PC,NAME .ENDM .ENDM GENCAL SAVREG GENCAL EXPR GENCAL TERM GENCAL HIS BE A REWIND? BCC 1$ ;YES SEV ;SET NOT REWIND RTS PC ;AND RETURN 1$: 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 ENDFIL: 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 ;N TR1: 0 ; .GLOBL RTARG,LTARG,DSARG,LHSARG LTARG: 0 RTARG: 0 DSARG: 0 LHSARG: 0 .GLOBL LTCOD,RTCOD,DSCOD,LHSCOD LTCOD: 0 RTCOD: 0 DSCOD: 0 LHSCOD: 0 .GLOBL CURTYP,CUROPR,CONVRT,DMPFLG CURTYP: 0 CUROPR: 0 CONVRT: 0 ;CONVERSION TYPE REQUIRED ; ; .GLOBL FAILSP,EXTFLG,STATE,LHSPOL FAILSP: 0 ;SP ON ENTRY FOR FAILURE EXIT EXTFLG: 0 ;GLOBAL EXIT DISPATCH FLAG STATE: 0 ;CURRENT STATE: NULL, ONE, OR MANY STACK ITEMS LHSPOL: 0 ;POLISH POINTER FOR LEFT HAND SIDE OF ASSIGNMENT ; ; PO 4: JSR PC,CNXC ;SKIP LEADING ZEROS CMPB #'0,@R1 BNE OUTSL5 INC R1 BR OUTSL4 OUTSL5: MOV #6,R0 OUTSL3: JSR PC,CNXC ;NEXT CHAR JSR PC,CHTEST ;CHECK TYPE BPL OUTSL1 ;NOT A DIGIT - EXIT DEC R0 ;COUNT THIS CHAR BEQ OUTSL2 ;0 => 6TH DIGIT MOVB (R1)+,R4 ;OUTPUT THE DIGIT JSR PC,OUTCHR BR OUTSL3 ;FOUND END OF STATEMENT NUMBER ; FIRST CHECK THAT AT LEAST ONE DIGIT EXISTS ; OUTSL1: CMP #6,R0 BEQ OUTSL2 ;MISSING NUMBER MOV (SP)+,R2 ;RESTORE R2 TSTB @R1 ;SET UP ZERO TEST AFTER RELEXP GENCAL RELTST GENCAL ABSEXP GENCAL ABSTST GENCAL ABSERR GENCAL REGEXP GENCAL GLBEXP GENCAL GETSYM GENCAL SETSYM GENCAL GETR50 GENCAL SETR50 GENCAL TSTR50 GENCAL GETNB GENCAL SETNB GENCAL GETCHR GENCAL SETCHR GENCAL TSTCOM GENCAL GSARG GENCAL TSTARG GENCAL SETIMB GENCAL SETIMM GENCAL SETDSP GENCAL STCODE GENCAL SSRCH GENCAL OSRCH GENCAL MSRCH GENCAL LSRCH GENCAL SETPF0 GENCAL SETPF1 GENCAL MUL GENCAL DIV GENCAL DNC GENCAL CVTOW PUSH MOV R0,R3 ; THE MOV CURSYM,R0 BIS #PSHMKM,PSHWD(R0) 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 / $BCKSP/ .BLISH BLOCK USED FOR CALL STATEMENTS WITH NO ARGUMENTS ; .GLOBL NARGCL 0 ;END OF POLISH 100400 ;END OF CALL WITH ZERO BYTE FIXUP .-. ;SERIAL OF ROUTINE NAME - FILLED IN 100000 ;DEPTH OF CALL =0 NARGCL: 102000 ;ZERO PARAMETERS ; ; BIT MAPS FOR NEW OPERATORS ; .NLIST BEX .GLOBL EXPBIT,MOVBIT,ARYBIT,REVBIT .GLOBL BEGBIT,ENDBIT BEGBIT: ;BEGINNING OF AREA TO CLEAR ON ;EACH COMPILATION DMPFLG: 0 EXPBIT: .BLKB 162. ;USED BY EXPRESSIONS AND ASSIGNMENTS MOVBIT: .BLKB 9. ;USED BY SIM EXIT CLV RTS PC ;ILLEGAL OR MISSING STATEMENT NUMBER ; OUTSL2: TRAP+51. MOV (SP)+,R2 ;RESTORE R2 SEV RTS PC ; .END NUM GENCAL R50UNP GENCAL MOVBYT ;ROLL HANDLER CALLS .MACRO SEARCH ROLNUM ;BINARY SEARCH MOV #ROLNUM,R0 CALL SEARCH .ENDM .MACRO SCAN ROLNUM ;LINEAR SCAN MOV #ROLNUM,R0 CALL SCAN .ENDM .MACRO SCANW ROLNUM ;LINEAR SCAN, ONE WORD MOV #ROLNUM,R0 CALL SCANW .ENDM .MACRO NEXT ROLNUM ;FETCH NEXT ENTRY MOV #ROLNUM,R0 CALL NEXT .ENDM .MACRO APPEND ROLNUM ;APPEND TO END OF ROLL MOV #ROLNUM,R0 CALL APPEND .ENDM .MACRO ZAP ROLNUM ;CLEAR ROLL MOV #ROLNUYTE 15,12,0 ENDF: .ASCII / .GLOBL $ENDFL/ .BYTE 15,12 .ASCII / $ENDFL/ .BYTE 15,12,0 .END PLE ASSIGNMENTS ARYBIT: .BLKB 8. ;USED BY ARRAY OPERATORS REVBIT: .BLKB 8. ;USED BY STACK REVERSAL OPERATORS .EVEN ENDBIT: ;END OF BIT TABLE AREA .END M,R0 CALL ZAP .ENDM GENCAL INSERT ;INSERT (MUST BE PRECEDED BY ONE OF ;THE ABOVE TO SET POINTERS) .MACRO CALL ADDRESS JSR PC,ADDRESS .ENDM .MACRO RETURN RTS PC .ENDM .MACRO TYPMSG ADDR ;TYPE A MESSAGE JSR R5,TYPMSG .WORD ADDR .ENDM .MACRO LSTLIN ADDR ;OUTPUT A LINE JSR R5,LSTLIN .WORD ADDR .ENDM .MACRO SERROR NUMBER JSR R5,SERROR .WORD 2000!NUMBER .ENDM .MACRO ERROR ARG ; SERROR <''ARG> BIS #ERR.'ARG,ERRBTS .ENDM ERRMNE: XXX= 00000 .TITLE OVLAY .IDENT /0612/ ;CP ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; ; ; OVERLAY CONTROLLER FOR THE FORTRAN COMPILER ; ; ; THE ENTRY INDEX IS A VALUE WHICH, WHEN ADDED TO ; THE START ADDRESS OF THE OVERLAY, POINTS TO A WORD ; CONTAINING THE ADDRESS OF THE DESIRED ROUTINE ; IN THE OVERLAY. ; ; THE OVERLAY INDEX POINTS TO THE DATA AREA DESCRIBING ; THE DESIRED OVERLAY. THIS AREA CONSISTS OF THE FOLLOWING ; ITEMS: ; ; WORD 0 - DISK ADDRESS O1 .IRPC CHAR, ABEMNOPQRTU ERR.'CHAR= XXX XXX= XXX*2 .ASCII /CHAR/ .ENDM .EVEN .MACRO SETNZ ADDR ;SET ADDR TO NON-ZERO FOR T/F FLAGS MOV SP,ADDR .ENDM .MACRO INIT FILE ;INIT A FILE MOV #FILE'CSI,R4 CALL INIT .ENDM .MACRO OPENO FILE ;OPEN AN OUTPUT FILE MOV #FILE'CSI,R4 CALL OPENO .ENDM .SBTTL PARAMETERS TAB= 11 LF= 12 VT= 13 FF= 14 CR= 15 SPACE= 40 CH.IOR= '! CH.QTM= '" CH.HSH= '# CH.DOL= '$ CH.PCT= '% CH.AND= '& CH.XCL= '' CH.LP= '( CH.RP= ')  .TITLE PATCH .IDENT /0601/ ; ;FORTRAN PATCH AREA ; ;COPYRIGHT 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; .PSECT ZZZHGH .BLKB 100. .END  .TITLE PARSE .IDENT /0609/ ; ;COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; MODIFIED BY R. BRENDER 1973 ; FOR "OPTIMIZED POLISH" ; .GLOBL PARXMK,LIST99 .GLOBL ARY001,EXPGEN,SUBEXP,GL1 .GLOBL STKCNT,CKOP,PLUS,MINUS,NXTCH,CHTEST .GLOBL ARYASG,IOL,NOT,GET,PWR,LT,GE,TEMP .GLOBL CURSYM,PARMKM,PARWD,FLABL,SERATR,PUTNAM .GLOBL BITM,MIF OVERLAY ; WORD 1 - CORE ADDRESS FOR LOADING ; WORD 2 - LENGTH (IN WORDS) OF THE OVERLAY ; WORD 3 - 4 ; WORD 4 - 0 ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; WARNING - THIS ROUTINE IS NOT ALLOWED TO SAVE ; TEMPORARIES ON THE STACK IF THEY WOULD REMAIN ; WHILE AN OVERLAY ROUTINE GETS CALLED, SINCE ; SOME OVERLAYS EXPECT ARGUMENTS ON THE STACK ; ---------------------- ; THUS A TEMPORARY STACK IS SET UP FOR THIS ROUTINE'S ; USE ONLY. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;CH.MUL= '* CH.ADD= '+ CH.COM= ', CH.SUB= '- CH.DOT= '. CH.DIV= '/ CH.COL= ': CH.SMC= '; CH.LAB= '< CH.EQU= '= CH.RAB= '> CH.QM= '? CH.IND= '@ CH.UAR= '^ DEFFLG= 000010 RELFLG= 000040 GLBFLG= 000100 REGFLG= 000001 LBLFLG= 000002 MDFFLG= 000004 ;RLD TYPES RLDT00= 00 ; ABSOLUTE DATA RLDT01= 01 ; INTERNAL RELOCATION TST #C RLDT02= 02 ; GLOBAL RELOCATION TST #G RLDT03= 03 ; INTERNAL DISPLACED RELOCATION TST ABS RLDT04= 04 ; GLOBAL DISPLACED RELOCATION TST X RLDT05= 05SC,OUTGL,EOL,OUTNAM,OUTCOM,OUTSER .GLOBL OUTTAB,PUTCHR,CV1,EXPMAP,GL2,FNSTK,ENTYWD .GLOBL OUTLN1,OUTST,OUTOCT,OUTCHR .GLOBL OUTCH2,OUTLN2,ARY004,FUN000 .GLOBL CNXC,ARYCHK,MTOP,STKBAS,SCANX .GLOBL PSHWD,PSHMKM,STRARY,STRFNC,COMMAC .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; SPACE = 40 TAB = 11 MODE = 60 OP = 20 .ENABL AMA ; ; MACRO FOR DOING EXPRESSION STACK ; OVERFLOW CHECKING ; .MACRO OVRCHK JSR PC,OVRCHK .ENDM ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; .MCALL .TRAN,.WAIT,.PARAM ; .PARAM ;REGISTER DEFS, ETC. ; .PSECT ZZZHGH ; .GLOBL OVLAY,JLIST,CLROVR,DISP,DESCR,OVLIST .GLOBL RDCNTX,LENGTH,LOWCOR,OVNUM OVLAY = . ;THIS IS THE LOWEST ADDRESS USED BY ;THE COMPILER ; .BLKW ;TO AVOID OVERLAY BY DEVICES THAT ONLY ;.TRAN ON TWO WORD BOUNDRIES OVNUM: .BLKW ;OVERLAY NUMBER CURRENTLY IN CORE DISP: 0+.-. TRA: .BLKW TSTK: TMPEND+.-. ;LOCAL STACK OSTK: .BLKW ;R0 SAVE TEMP: .BLKW 15. ;TEMPORARIES FOR SA! ; GLOBAL ADDITIVE RELOCATION TST #X+6 RLDT06= 06 ; GLOBAL ADDITIVE DISPLACED RELOCATION TST #X+6 RLDT07= 07 ; NEW CSECT RLDT10= 10 ; SEQUENCE BREAK RLDT11= 11 ; LIMIT RLDT15= 15 ; SECTOR ADDITIVE RELOCATION TST #O RLDT16= 16 ;SECTOR ADDITIVE DISPLACED RELOCATION TST #O+6 GSDT00= 00*400 ; OBJECT MODULE NAME GSDT01= 01*400 ; PROGRAM SECTION NAME GSDT02= 02*400 ; INTERNAL SYMBOL TABLE GSDT03= 03*400 ; TRANSFER ADDRESS GSDT04= 04*400 ; SYMBOL DECLARATION GSDT05= 05*400 ; LOCAL SECTION NAM" .TITLE PSTFTN PERMANENT SYMBOL TABLE .IDENT /0503/ ; COPYRIGHT 1972, 1973 DIGITAL EQUIPMENT CORP. ; MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. .CSECT PSTFTN XFTN = 1 .GLOBL PSTBAS, PSTTOP ;LIMITS .GLOBL WRDSYM ;POINTER TO .WORD DR1= 1 ;DESTRUCTIVE REFERENCE IN FIRST FIELD DR2= 2 ;DESTRUCTIVE REFERENCE IN SECOND FIELD .GLOBL DFLGEV, DFLGDG, DFLCND, DFLMAC, DFLRPT DFLGEV= 200 #; ; FORTRAN EXPRESSION PROCESSING PACKAGE ; ; ; SUBEXP - CONVERTS A STRING OF ASCII POINTED TO BY ; R1 INTO AN INTERNAL POLISH STRING WITH ; EXPLICIT MODE DESCRIPTIONS. UPON RETURN, ALL OF THE ; POLISH GOODIES ARE ON THE STACK WITH R0 POINTING TO ; THE START AND SP POINTING TO THE END. ; ALSO, R2 HAS IN BITS 12-15 THE TYPE OF THE ; POLISH RESULT. THE POLISH LIST WILL ALWAYS BE ; TERMINATED BY A ZERO WORD. ; ; ; REGISTERS CHANGED - R0,R1,R2,R3,R4,R5. ; SUBEXP: MOV S$VING GROCERIES IN TMPEND=. .GLOBL TSTK,TMPEND ; ; ; ; ; - THIS ROUTINE GETS AN OVERLAY IF NECESSARY ; AND THEN DISPATCHES TO IT VIA THE ENTRY INDEX. ; JLIST: MOV PSW,TEMP MOV R0,OSTK ;REMEMBER R0 MOV TSTK,R0 ;SET UP LOCAL STACK CLR -(R0) CLR -(R0) MOV R5,-(SP) MOV R4,-(SP) MOV DISP,R5 ;GET THE ENTRY INDEX CLR DISP ;CLEAR POINTER FOR NEXT TIME AROUND MOV R5,-(SP) ;MULTIPLY ASL R5 ;BY ADD (SP)+,R5 ;THREE MOV OVLIST+2,R4 ;GET TABLE ADDRESS MOV OVLIST+4,-(R0) ADD R%E GSDT06= 06*400 ; VERSION IDENTIFICATION BLKT01= 01 ;GSD BLKT02= 02 ; GSD END BLKT03= 03 ; TEXT BLOCK BLKT04= 04 ; RLD BLOCK BLKT05= 05 ; ISD BLKT06= 06 ; MODULE END MT.RPT= 177601 MT.IRP= 177602 MT.MAC= 177603 MT.MAX= MT.MAC SRCLEN= 132. OCTLEN= 16. LINLEN= 132. LSTLEN= OCTLEN+LINLEN OBJLEN= 42. RLDLEN= 42. BPMB= 8.*2 ;BYTES PER MACRO BLOCK .IF NDF XFTN STKSIZ= 2000 ;SP SIZE .IFF STKSIZ=3000 .ENDC LPP= 56. ;LINES PER PAGE ;DIRECTIVE FLAGS DEFINED I& ;DIRECTIVE REQUIRES EVEN LOCATION DFLGDG= 100 ;DIRECTIVE IS DATA-GENERATING DFLCND= 040 ;CONDITIONAL DIRECTIVE DFLRPT= 020 ;REPEAT DIRECTIVE DFLMAC= 010 ;MACRO DIRECTIVE .MACRO OPCDEF NAME, CLASS, VALUE FLAGS .IF LE CLASS'.-6. .RAD50 /NAME/ .BYTE FLAGS+0 .GLOBL OPCL'CLASS .BYTE 200+OPCL'CLASS .WORD VALUE .ENDC .ENDM .MACRO DIRDEF NAME, FLAGS .GLOBL NAME .RAD50 /.'NAME/ .BYTE FLAGS+0 .BYTE 0 .WORD NAME .ENDM PSTBAS: ;BASE 'P,R5 ;SET UP MOV MTOP,R4 ;CHECK TO SEE THAT ADD #MODE+OP+70.,R4 ;ENOUGH STACK SPACE REMAINS CMP R4,SP ;FOR THIS RECURSION LEVEL BLO .A1 ;ALL IS WELL EXPSTK: MOV STKBAS,SP ;PANIC! TRAP+129. ;EXPRESSION STACK OVERFLOW!! JMP SCANX ;EXIT .A1: SUB #MODE,SP ; MODE LIST MOV SP,R4 ;SET UP SUB #OP,SP ;OPERATOR LIST CLR -(R4) ;SET PRIORITY ZERO OP MOV SP,STKCNT ;REMEMBER POLISH START SUBEX1: JSR PC,CKOP ;GO SEE IF A UNARY EXISTS BVS SUB003 ;NO UNARY FOUND CMP PLUS,R0 ;IS IT A (4,R5 ;GET ADDRESS OF ITEMS MOVB @R5,R4 ;GET OVERLAY INDEX NEEDED CLR TRA ;GET MOVB 1(R5),TRA ;THE ENTRY INDEX MOVB 2(R5),R5 ;GET THE RETURN FLAG RETLP: MOV OVTAB(R4),OV0 MOV OVTAB+2(R4),OV0+2 MOV OVTAB+4(R4),OV0+4 .TRAN #TLB,#OV0 .WAIT #TLB TSTB R5 ;RETURN?? BEQ GO003 ;NO MOV OVNUM,4(R0) GO003: MOV R4,OVNUM GO: MOV (R0)+,R4 ;GET VECTOR POINTER TST (R0) ;RETURN?? BNE GO001 ;YES ADD OVLIST+4,TRA ;COMPUTE MOV @TRA,TRA ;FINAL TRANSFER ADDRESS TSTB R5 ;DOES IT RETURN?)N PST .GLOBL DFLGEV, DFLGDG, DFLCND, DFLRPT, DFLMAC .SBTTL ROLL DEFINITIONS .MACRO GENROL NAME, BASE, TOP, SIZE .CSECT ROLBAS NAME'ROL= .-ROLBAS .WORD BASE .CSECT ROLTOP .WORD TOP .CSECT ROLSIZ .WORD SIZE*2 .ENDM .CSECT ROLBAS ;ROLL BASE ROLBAS: .CSECT ROLTOP ;ROLL TOP ROLTOP: .CSECT ROLSIZ ;ENTRY SIZE ROLSIZ: .CSECT ;START OF TABLE TO BE FILLED IN GENROL SYM, 0, 0,4 ;SYMBOL TABLE GENROL MAC, 0, 0,4 ;MACRO ROLL GENROL LSY, 0, 0* .IF NDF XFTN OPCDEF , 01, 170600, DR1 OPCDEF , 01, 170600, DR1 OPCDEF , 01, 005500, DR1 OPCDEF , 01, 105500, DR1 .IFTF OPCDEF , 02, 060000, DR2 .IFT OPCDEF , 11, 172000, DR2 OPCDEF , 11, 172000, DR2 OPCDEF , 09, 072000, DR2 OPCDEF , 09, 073000, DR2 OPCDEF , 01, 006300, DR1 OPCDEF , 01, 106300, DR1 OPCDEF , 01, 006200, DR1 OPCDEF , 01, 106200, DR1 OPCDEF , 04, 103000, OPCDEF , 04, 103400, OPCDEF , 04, 001400, OPCDEF , 04, 002000, OPCDEF , 04, 003000, OPCDEF , 04, 101000, OPCDEF , 04, 103000, OPCDEF , 02, 040000, DR2 OPCDEF , 02, 140000, DR2 OPCDEF , 02, 050000, DR2 OPCDEF , 02, 150000, DR2 OPCDEF , 02, 030000, OPCDEF , 02, 130000, OPCDEF , 04, 003400, OPCDEF , 04, 103400, OPCDEF , 04, 101400, OPCDEF /PTH TO NORMAL TST (R0)+ ;BACK UP THE POINTER MOV R0,R3 ;REMEMBER WHERE POLISH STARTS MOV (R0)+,STKCNT ;RESTORE MOV (R0)+,R5 ;THE LOCAL MOV (R0)+,R4 ;GOODIES SUB10A: CMPB (R1)+,#' ;SKIP OVER BEQ SUB10A ; BLANKS DEC R1 ;NOW BACK UP POINTER TO PROPER PLACE CMPB (R1)+,#') ;IS THERE A MATCHING PAREN??? BEQ SUB010 ;YES DEC R1 ;NO,GIVE A DIAGNOSTIC AND TRAP+25. ;BACK UP OVER THE BAD CHARACTER SUB010: MOV -(R3),-(R0) ;NOW PACK THE POLISH IN BNE SUB010 ;REAL TIGHT TST (R0)+ ;0 GO002 ;JUMP IF RTS IS REQUIRED CMP (R0)+,(R0)+ ;DISCARD TWO ITEMS GO004: MOV R0,TSTK ;SAVE LOCAL STACK MOV OSTK,R0 ;RESET R0 MOV TEMP,PSW JMP @TRA ;GO TO IT GO002: MOV (R0)+,TRA ;GET RETURN ADDRESS TST (R0)+ ;POP TEMPORARY BR GO004 ;RETURN TO CALLER ; ; START CONTROLLER - LOAD IN OVERLAY 0 AND JUMP TO RSET ; .GLOBL START,RSET START: CLR TRA TST OVNUM ;ARE WE ALREADY IN OVERLAY 0?? BEQ 1$ ;YES, DON'T RELOAD. MOV #OVTAB,R0 ;GET ADDR1URE MACTOP: .BLKW ;TOP OF MACRO STORAGE ROLNDX: .BLKW ;ROLL INDEX ROLPNT: .BLKW ;ROLL POINTER ROLUPD: .BLKW ;UPDATE IF NON-ZERO .CSECT .CSECT IMPURE PASS: .BLKW ;NEXT GROUP MUST STAY TOGETHER SYMBOL: .BLKW 2 ;SYMBOL ACCUMULATOR MODE: FLAGS: .BLKB 1 ;FLAG BITS SECTOR: .BLKB 1 ;SYMBOL/EXPRESSION TYPE VALUE: .BLKW 1 ;EXPRESSION VALUE RELLVL: .BLKW 1 .BLKW 2 ;END OF GROUPED DATA CLCNAM: .BLKW 2 ;CURRENT LOCATION COUNTER SYMBOL CLCFGS: .BLKB 1 CLCSEC: .BLKB 1 CLCL2, 04, 002400, OPCDEF , 04, 100400, OPCDEF , 04, 001000, OPCDEF , 04, 100000, OPCDEF , 00, 000003, .IFTF OPCDEF
, 04, 000400, .IFT OPCDEF , 04, 102000, OPCDEF , 04, 102400, OPCDEF , 00, 000257, OPCDEF , 00, 170000, OPCDEF , 00, 000241, OPCDEF , 00, 000250, OPCDEF , 01, 005000, DR1 OPCDEF , 01, 105000, DR1 OPCDEF , 013DISCARD THE ZERO WORD MOV R0,SP ;RE-FUDGE THE STACK MOV STKCNT,R3 ;COMPUTE SUB SP,R3 ;THE NEW RESULT POSITION TST IOL ;IS THIS AN I/O LIST? BNE ASGN9B ;YES BR SUB011 ;FALL BACK INTO MAIN LOOP ASGN9B: JMP LIST99 ; NOW, WASN'T THAT PAINLESS????? ; ; ; CONTINUE THE STATEMENT PROCESSING ; SUB002: CMP NOT,R0 ;IS IT A .NOT. ??? BEQ SUB013 ;YES, PUT AWAY AND CONTINUE TRAP+8. ;ILLEGAL UNARY SUB003: JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#'4ESS OF OVERLAY 0 MOV #OV0,R1 ;GET ADDRESS OF TRAN BLOCK MOV (R0)+,(R1)+ ;SET UP MOV (R0)+,(R1)+ ;THE MOV (R0)+,(R1)+ ;INPUT INFORMATION .TRAN #TLB,#OV0 ;INPUT OVERLAY 0 .WAIT #TLB ;AND WAIT FOR IT 1$: JMP RSET ;NOW GO-GO ; ; CLEAR OVERLAY STACK ; CLROVR: MOV #TMPEND,TSTK RTS PC ; ; OVERLAY LINK BLOCK ; .GLOBL TLB 0 ;ERROR RETURN TLB: 0 ;DDB LINK .RAD50 /OVR/ 1 .RAD50 /SY/ ;ALL INPUT FROM THE SYSTEM DEVICE ; ; OVERLAY DESCRI5OC: .BLKW 1 CLCMAX: .BLKW 1 NSWFLG: .BLKW .CSECT IMPPAS ;CLEAR EACH PASS .ODD OBJSEC: .BLKB 1 ;OBJECT FILE SECTOR OBJLOC: .BLKW 1 ;OBJECT FILE LOCATION TEMP: .BLKW 6 CRADIX: .BLKW ;CURRENT RADIX CHRPNT: .BLKW ;CHARACTER POINTER SYMBEG: .BLKW ;POINTER TO START OF SYMBOL ENDFLG: .BLKW LINCNT: .BLKW PAGNUM: .BLKW .CSECT IMPLIN ;CLEARED EACH LINE ERRBTS: .BLKW ARGCNT: .BLKW EXPFLG: .BLKW .CSECT ;RETURN TO NORMAL .SBTTL PROGRAM INITIALIZATION .IF DF XFTN 6, 170400, DR1 OPCDEF , 01, 170400, DR1 OPCDEF , 00, 000242, OPCDEF , 00, 000244, OPCDEF , 02, 020000, OPCDEF , 02, 120000, OPCDEF , 11, 173400, OPCDEF , 11, 173400, OPCDEF , 00, 000254, OPCDEF , 01, 005100, DR1 OPCDEF , 01, 105100, DR1 OPCDEF , 01, 005300, DR1 OPCDEF , 01, 105300, DR1 OPCDEF
, 07, 071000, DR2 OPCDEF , 11, 174400, DR2 OPCDEF , 11, 174400, DR27( ;IS IT A PAREN?? BNE SUB001 ;NO .GLOBL GCMPLX JSR PC,GCMPLX ;SEE IF IT IS COMPLEX BVS SUB01B ;NOT COMPLEX MOV #5,R2 ;SET TYPE TO COMPLEX BR SUB01A ;GO HANDLE COMPLEX CONSTANT SUB01B: BCC SUB036 ;ISN'T COMPLEX CONSTANT, GO AWAY TRAP+111. ;ILLEGAL FORM FOR CONSTANT BR SUBEX1 ;RE-LOOP SUB001: DEC R1 ;NO, BACK UP POINTER JSR PC,GETCHK ;NOW TRY FOR AN OPERAND BVS SUB35A SUB01A: MOV R0,-(SP) ;SAVE R0 OVRCHK ;CHECK FOR STACK OVERFLOW .GLOBL ASGMKM,ASGWD MOV CURSYM,R0 ;SEFPTOR POINTERS ; .GLOBL OVTAB,DPTR LENGTH: .BLKW ;FILE LENGTH LOWCOR: .BLKW ;LOWEST LOCATION IN CORE OVTAB: .BLKW 3 ;OVERLAY 0 .BLKW 3 ;OVERLAY 1 .BLKW 3 ;OVERLAY 2 .BLKW 3 ;OVERLAY 3 .BLKW 3 ;OVERLAY 4 RDCNTX = .-LENGTH/2 DPTR: .BLKW 2 ;DIAGNOSTIC POINTER ; .GLOBL OV0 ;TRAN BLOCK PROTOTYPE OV0: .BLKW ;STARTING BLOCK .BLKW ;STARTING CORE ADDRESS .BLKW ;WORD COUNT 4 ;INPUT 0 ;RESERVED ; ; THIS IS THE END. SIMPLE, WASN'T IT???? ; .END E .GLOBL LINKOL,OBJLS,LINKAS,ASMLS,LINKSL,SRCLS .GLOBL PALFTN,PAG,LINCT,LSTVAL,ASMMOD,LOWLOC .GLOBL MTOP,ECNT,RUNER ;INTERFACE CODE BETWEEN FORTRAN AND MACRO $RET: .BLKW PALFTN: MOV (SP)+,$RET ;GET RETURN ADDRESS MOV #4,ASMMOD ;SET MODE TO READ .INIT #LINKAS .ENDC .IF NDF XFTN .GLOBL START, CONT, FIN PRGLIM: .LIMIT START: .INIT #CODLNK ;INIT KEYBOARD OUTPUT CLR LOUTW ;CLEAR WAIT FLAGS TYPMSG HELLO ;SAY HELLO .INIT #CIDLNK CONT: MOV PRGLIM,SP ;SET STACK POINTERH OPCDEF , 06, 104000, OPCDEF , 00, 000000, OPCDEF , 01, 005200, DR1 OPCDEF , 01, 105200, DR1 OPCDEF , 00, 000004, .IFTF OPCDEF , 01, 000100, OPCDEF , 05, 004000, DR1 .IFT OPCDEF , 11, 177400, DR2 OPCDEF , 11, 177400, DR2 OPCDEF , 14, 177000, DR2 OPCDEF , 14, 177000, DR2 OPCDEF , 14, 177000, DR2 OPCDEF , 14, 177000, DR2 OPCDEF , 11, 172400, DR2 OPCDEF , 1GE IF .GLOBL ERRFLG TSTB ERRFLG ;IS SPECIAL ERROR FLAG SET?? BEQ SUB01C ;NO TST R3 ;IS THIS A SIMPLE VARIABLE? BNE SUB01C ;NO BIT #SGLMKM,SGLWD(R0) ;IS THIS THE FIRST OCCURRENCE? .GLOBL SGLMKM,SGLWD BEQ SUB01C ;NO TRAP+120. ;NO PREVIOUS REFERENCE SUB01C: BIT #ASGMKM,ASGWD(R0) ; THE ASSIGN BIT IS SET BEQ SUB014 ;NOT SET TRAP+110. ;SET, SO WARN USER SUB014: MOV (SP)+,R0 ;RESTORE R0 SUB015: TST R3 ;CHECK MODE BGT SUB06X ;SPECIAL HAND""""""" """"""""""""""""""""""""""""""""""""""""""""""""""""""""""23333DD@@@DDDDDDDDDDDDDDDD@DDDDDDDDDDDDDDDDDDDDDD@@DDDDDDDADDB CkQ(kQ *KT:kQ T`*}kQ axkQ l  aʋaՀ$ & * P$ ΋Ί   ΋   d Ί  ( 1'u  Q$f $5@ U C΋ Cb M΋U@ U &  B" .&0 I .IFTF CALL CLRIMP .IFT CLR SRCLNK CLR LSTLNK CLR OBJLNK .RSTRT #FIN ;SET RESTART ADDRESS BIS #LC.ME,LCMASK ;DEFAULT TO .NLIST ME .IFF MOV #LOWLOC,SP ;RESET THE STACK .ENDC MOV #DUMROL,R1 ;POINT TO SEPARATOR ROLL 2$: MOV SP,ROLBAS(R1) ;FILL IN VARIABLE BASE MOV SP,ROLTOP(R1) ; AND TOP CLRB ROLSIZ+1(R1) ;CURRENT SIZE DEC R1 DEC R1 BGE 2$ ;LOOP IF MORE ROLLS SUB #400,SP MOV SP,MACTOP ;SET NEW SP AND SET TOP OF MACRO STORAGE .IF DF XFTN MOV MTOP,-(SP) ;GET TOP KLING FOR ARRAY OR FUNCTION SUB007: MOV R0,-(SP) ;PLACE ON POLISH LIST AND ;SET MODE SUB009: MOV STKCNT,R3 ;COMPUTE SUB SP,R3 ;POSITION BIC #177770,R2 ;ON POLISH LIST AND CMPB R2,#6 ;IS IT ASCII? BNE SUB09A ;NO MOV #2,R2 ;PRETEND IT IS INTEGER SUB09A: SWAB R2 ;REMEMBER ASL R2 ASL R2 ;THE ASL R2 ;MODE ASL R2 ;TOO SUB011: BIS R2,R3 ;STORE MODE IN BITS 13-15 MOV R3,-(R5) ;SAVE IN THE MODE LIST JSR PC,CKOP ;GET AN OPERATOR BVS SUB12X ;SPECIAL CHECK IF NO OPERATOR CL4, 176400, DR2 OPCDEF , 11, 172400, DR2 OPCDEF , 01, 170100, OPCDEF , 00, 170004, OPCDEF , 00, 170003, OPCDEF , 10, 006400, OPCDEF , 01, 106500, OPCDEF , 01, 006500, OPCDEF , 11, 171400, DR2 OPCDEF , 11, 171400, DR2 .IFTF OPCDEF , 02, 010000, DR2 OPCDEF , 02, 110000, DR2 .IFT OPCDEF , 01, 106600, DR1 OPCDEF , 01, 006600, DR1 OPCDEFMOF MONITOR CLR -(SP) ;AND FUDGE FACTOR CMP LSTVAL,#2 ;LISTING NEEDED? BLT 4$ ;NO INCB LOUTF+1 4$: .ENDC .IF NDF XFTN .WRITE #CODLNK,#HASH ;SPECIAL (NO CR/LF) .WAIT #CODLNK ;WAIT ON KB CONT1: MOV #CIDHDR+6,R1 MOV #CIDLEN,-(R1) CLR -(R1) MOV #CIDLEN,-(R1) .READ #CIDLNK,R1 .WAIT #CIDLNK .CSI1 #CMDBUF MOV (SP)+,R2 ;GET ERROR FLAG BEQ 10$ ; OK MOVB #CH.QM,(R2)+ ;ERROR, SET "?" CLRB (R2) ; AND TERMINATOR TYPMSG CIDBUF BR CONT 10$: MOV #CMDBUF,R1 MOV #CMN .TITLE RDCI ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY B. ROSS ; .CSECT .GLOBL $DCI,$RCI ; $DCI --- ASCII TO DOUBLE CONVERSION. ; $RCI --- ASCII TO REAL CONVERSION. ; CALLING SEQUENCE: ; PUSH ADDRESS OF START OF FIELD ; PUSH LENGTH OF FIELD ; PUSH FORMAT SCALE D FROM W.D ; PUSH P FORMAT SCALE ; JSR PC,$DCI (OR $RCI) R0=%0 R1=%1 R2=%2 R3=%3OMP R0,NOT ;IS IT A NOT?? BNE SUB005 ;NO TRAP+79. ;YES, GIVE ERROR DIAGNOSTIC SUB005: MOV R0,-(R4) ;GET THE PRIORITY CMPB (R4),2(R4) ;COMPARE CURRENT PRIORITY ;TO PREVIOUS BGT SUB08X ;JUMP IF HIGHER TST @R4 ;IS THIS ITEM THE END? BEQ SUB039 ;YES TST 2(R4) ;NO, IS THIS THE ONLY ENTRY? BEQ SUB08X ;YES, PRETEND IT HAS HIGH PRIORITY SUB039: TST (R4)+ ;DISCARD ENTRY MADE IN HASTE SWAB @R4 ;MOVE THE OPERATOR BITS CLRB 1(R4) ;AND MAKE RP , 07, 070000, DR2 OPCDEF , 11, 171000, DR2 OPCDEF , 11, 171000, DR2 OPCDEF , 01, 005400, DR1 OPCDEF , 01, 105400, DR1 OPCDEF , 01, 170700, DR1 OPCDEF , 01, 170700, DR1 OPCDEF , 00, 000240, OPCDEF , 00, 000005, OPCDEF , 01, 006100, DR1 OPCDEF , 01, 106100, DR1 OPCDEF , 01, 006000, DR1 OPCDEF , 01, 106000, DR1 OPCDEF , 00, 000002, .IFTF OPCDEF , 03, 000200, DQDSAV,R2 CALL XMIT7 ;SAVE INITIAL CMD HEADER MOV #2,CMDBUF INIT OBJ ;PROCESS OBJECT FIRST BEQ 11$ OPENO OBJ 11$: MOV R2,-(SP) ;SAVE BUFFER SIZE ASR R1 ;ANY MORE OUTPUT FIELDS? BCS 12$ ; NO INIT LST ;YES, PROCESS LISTING FIELD BEQ 12$ ;BRANCH IF EMPTY OPENO LST ADD R2,(SP) ;OK, UPDATE BUFFER SIZE ASR R3 ;ROTATE TERMINAL BIT INTO POSITION MOVB R3,LOUTF+1 12$: CLR CMDBUF ;SET FOR INPUT CLR -(SP) ;INIT FOR MONF 13$: INIT SRC ;SET FOR SOURCE BNE 14$ ;BRANCH IF NONR R4=%4 R5=%5 SP=%6 PC=%7 NUMEND=0 POINTL=2 DIGITS=4 BEXP=6 ESIGN=8. SIGN=10. EXP=12. P=30. D=32. ERF=26. LENGTH=34. TEMP=LENGTH RESULT=P START=36. END=START $RCI: CLR -(SP) ;CLEAR ERROR FLAG INC @SP ;SET REAL CONVERSION FLAG BR CONV $DCI: CLR -(SP) ;CLEAR ERROR FLAG AND SET FOR DOUBLE CONV: MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) CLR -(SP) ;CLEAR EXP CLR -(SP) ;CLEAR SIGN CLR -(SP) ;CLEAR ESIGN MOV #65.,-(SP) ;INITIALIZESOOM FOR THE MODE FLAG OVRCHK ;STACK OVERFLOW CHECK MOV (R4)+,-(SP) ;GET THE HIGHER OPERATOR BEQ SUB37X ;ALL DONE BIS #100000,@SP ;SET OPERATOR FLAG CMPB @SP,PWR+1 ;IS IT EXPONENTIATION? BEQ SUB017 ;YES CMPB @SP,NOT+1 ;CHECK FOR NOT BEQ SUB041 ;IT IS ONE CMPB @SP,#11 ;ALSO CHECK FOR UNARY MINUS BNE SUB040 ;IT ISN'T ONE SUB041: MOV @R5,-(R5) ;FAKE OUT THE MODE LIST SUB040: CMP @R5,2(R5) ;CHECK FOR MODE OF OPERATIONS BLT SUB019 ;FIRST IS HIGHER THAN SECOND MOV (R5)+,R3 ;SECOTR1 .IFT OPCDEF , 00, 000006, OPCDEF , 01, 005600, DR1 OPCDEF , 01, 105600, DR1 OPCDEF , 00, 000277, OPCDEF , 00, 000261, OPCDEF , 00, 000270, OPCDEF , 00, 170011, OPCDEF , 00, 170001, OPCDEF , 00, 170002, OPCDEF , 00, 170012, OPCDEF , 00, 000262, OPCDEF , 00, 000264, OPCDEF , 08, 077000, DR1 OPCDEF , 13, 000230, OPCDEF , 00, 170005, OPCDEF , 00, 170006, OPCDEF , 12, 176000, DR2 OPCDEF , 12, 175400, DR2 OPCDEF , 12, 175400, DR2 OPCDEF , 12, 176000, DR2 OPCDEF , 12, 175400, DR2 OPCDEF , 12, 175400, DR2 OPCDEF , 12, 174000, DR2 OPCDEF , 12, 175000, DR2 OPCDEF , 12, 174000, DR2 OPCDEF , 01, 170200, DR1 OPCDEF , 00, 170007, OPCDEF , 01, 170300, DR1 OPCDEF , 02, 160000, DR2 OPCDEF , 11, 173000, DR2 OPCDEF , 11, 173000, DR2 OPCDEF , 01, 000300, DR1 OPCDEF , 01, 006700, DR1 OPCDEF , 06, 104400, OPCDEF , 01, 005700, OPCDEF , 01, 105700, OPCDEF , 01, 170500, OPCDEF , 01, 170500, OPCDEF , 00, 000001, OPCDEF , 05, 074000, DR2 ; DIRDEF .IFTF DIRDEF , DFLGDG .IFT DIRDEF , DFLGDG DIRDEF DIRDEF ],RUNER ;SET FATAL ERROR FLAG IF NEEDED MOV #LOWLOC,R1 ;GET TOTAL SPACE SUB MTOP,R1 ;IN CLC ROR R1 ;WORDS MOV ROLBAS+0,R0 ;GET SPACE SUB MACTOP,R0 ;REMAINING CLC ROR R0 ;IN WORDS SUB R0,R1 ;GET SPACE USED JMP @$RET ;RETURN TO CALLER .ENDC .IF NDF XFTN MOV #FINMSG,R1 ;SET FOR FINAL MESSAGE MOV #LINBUF,R2 MOVBYT ;MOVE INTO LINBUF MOV ERRCNT,R1 DNC ;PRINT IN DECIMAL MOV #FINMS1,R1 MOVBYT MOV ROLBAS+0,R1 SUB MACTOP,R1 ROR R1 DNC MOV #1,LOUTR ;REQUEST K^BNE NONZ TST R3 BEQ FIELD NONZ: CMPB R4,#'9 BGT EXPCK ;CHECK FOR EXPONENT DEC DIGITS(SP) ;COUNT AS A SIGNIFICANT DIGIT BGE A2I ;JUMP IF WE CAN USE THIS DIGIT INC EXP(SP) ;COMPENSATE FOR SKIPPED DIGIT BR FIELD A2I: SUB #60,R4 ;CONVERT ASCII TO INTEGER JSR PC,MUL5 ;MULTIPLY BY 5 JSR PC,LEFT ;DOUBLE RESULT FOR 10 ADD R4,R3 ;ADD IN CURRENT DIGIT ADC R2 ADC R1 ADC R0 ;END OF CONVERT FOR THIS DIGIT FIELD: CMP R5,END(SP) ;CHECK FOR END OF FIELD BLT NEXT MOV R5,@SP ;POINTER TO LAS_;BYTE OR LOGICAL EXPONENT NOT ALLOWED SUB029: MOV R2,R3 ;GET MODE OF BASE SUB045: MOV STKCNT,R2 ;GO BACK TST (R5)+ ;DELETE BASE TYPE SUB SP,R2 ;POSITION OF RESULT BR SUB33A SUB028: CMP R3,#40000 ;IS IT DOUBLE OR COMPLEX? BGE SUB031 ;YES SUB032: CMP R2,#30000 ;IS IT REAL, DOUBLE, ETC. BGE SUB030 ;YES TRAP+81. ;I**R NOT LEGAL SUB030: CMP R2,#50000 ;IS IT COMPLEX? BLT SUB029 ;NO SUB046: TRAP+82. ;YES, C**R NOT ALLOWED BR SUB029 SUB031: BEQ SUB034 ;COUBLE TRAP+84. ;ERROR IF ` DIRDEF , DFLGEV .IFTF DIRDEF , DFLGDG DIRDEF .IFT ; DIRDEF DIRDEF DIRDEF .IFTF ; ; TO AVOID A CONFLICT WITH THE FORTRAN 'END' ; STATEMENT PROCESSOR, MACFTN USES THE LABEL ; '$END' FOR ITS END STATEMENT ROUTINE. ; .GLOBL $END .RAD50 /.END / .WORD 0,$END .IFT DIRDEF , DFLCND DIRDEF , DFLMAC DIRDEF , DFLRPT DIRDEF ; DIRDEF .IFTF DIRDEF .IFT DIRDEF DIRDEF /ERRORS DETECTED: / FINMS1: .ASCIZ /FREE CORE: / .EVEN .ENDC SERROR: ;"S" ERROR .IF DF XFTN ; IN FORTRAN SUBSET OF MACRO THE ONLY ERROR THAT ; CAN OCCUR IS CORE OVERFLOW, YES? CLR R1 ;CLEAR R1 SO ERROR MESbT NUMERIC TO NUMEND SCALE: TST R0 BNE SCALE1 ;JUMP IF NUMBER NOT 0 TST R1 BNE SCALE1 TST R2 BNE SCALE1 TST R3 BEQ ZERO ;INPUT NUMBER IS 0 SCALE1: CMP @SP,R5 ;CHECK NUMEND BNE NOP ;JUMP IF THERE WAS AN EXPONENT FIELD SUB P(SP),EXP(SP) ;USE THE FORMAT P SCALE NOP: TST POINTL(SP) BNE POINT ;JUMP IF THERE WAS A DECIMAL POINT MOV D(SP),@SP ;USE THE D SCALE POINT: SUB POINTL(SP),@SP SUB @SP,EXP(SP) ;FORM COMPLETE DECIMAL EXPONENT BGT MUL ;MULTIPLY BY 10**EXP BLT DIV ;JUMP IF DECIcCOMPLEX BR SUB034 SUB035: TRAP+33. ;ILLEGAL OPERAND MOV R1,-(SP) ;SAVE CURRENT TEXT POINTER .GLOBL FAKE MOV #FAKE,R1 ;GET FAKE STRING POINTER JSR PC,GETCHK ;GET A FAKE OPERAND MOV (SP)+,R1 ;RESTORE REAL POINTER JMP SUB015 ;RETURN TO REAL WORLD SUB006: CMP R3,#2 ;IS IT A FUNCTION NAME???? BLT ARY000 ;NO, TRY FOR ARRAY JSR PC,CNXC ;SKIP BLANKS CMPB (R1),#'( ;IS THIS A FUNCTION REFERENCE? BNE SUB07A ;NO, PRETEND IT IS A VARIABLE .GLOBLdLT4 > .IFTF DIRDEF .IFT ; DIRDEF DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF , DFLCND DIRDEF DIRDEF , DFLMAC DIRDEF , DFLMAC DIRDEF , DFLGEV DIRDEF ; DIRDEF ; DIRDEF , DCMAC DIRDEF , DFLMAC DIRDEF DIRDEF DIRDEF DIRDEF DIRDEF DIRDEF ; DIRDEF ; DIRDEF ; DIRDEF DIRDEF DIRDEF DIRDEF , DFLGDG+DFLGEV ; DIRDEF DIRDEF , DFLRPT ; DIRDEF DIRDEF .IFTF DIRDEF .IFT ; DIRDEF <TRUi� MOV #72.,4(R0) ;SET FOR MANY SWITCHES .CSI2 R4 ;TEST THE FIELD BIT #2,(SP) ;TOO MANY SWITCHES? BEQ 1$ ; NO SERROR 203 1$: MOV 6(R0),-(SP) ;ANY DEVICE? BEQ 2$ ; NO .INIT R0 ;OK, INIT THE DEVICE .STAT R0 ;GET CHARACTERISTICS MOV (SP)+,R3 ;SAVE STATUS WORD TST (SP)+ ;PRUNE DEVICE NAME MOV (SP)+,R2 ;SET SIZE ; MOV 4(R4),R1 ;POINT TO FILE BLOCK ; MOV (R1)+,SRCNAM ;SAVE NAME FOR OUTPUT DEFAULT ; MOV (R1)+,SRCNAM+2 2$: MOV R0,R4 ;POINT TO LINK BLOCK CALL TSTSW ;TEST SWITCj�TL(SP) ;SAVE A POINTER TO THE . +1 BR FIELD ;GO FOR NEXT CHARACTER ERROR: COMB ERF+1(SP) ;FLAG ERROR ZERO: CLR R0 ;RESULT IS 0 CLR R1 CLR R2 CLR R3 JMP STORE ;GO PUSH RESULT AND RETURN EXPCK: CMPB R4,#'E BEQ EXPT ;JUMP IF E CMPB R4,#'D BNE ERROR ;IF NOT E OR D THEN ERROR EXPT: MOV R5,@SP ;SAVE POINTER TO END OF NUM +1 DEC @SP ;DECREMENT NUMEND MOV R3,TEMP(SP) CLR R3 CMP R5,END(SP) BGE ERROR ;JUMP IF NO ROOM FOR EXP MOVB (R5)+,R4 BIC #177600,R4 CMPB R4,#'+ ;CHECK FOR +EXk�SUB003 ;GO CHECK FOR OPERAND ����������������������������������������; ; END PROCESSING FOR POLISH SUBEXPRESSION HANDLER ; SUB037: MOV (R5)+,R2 ;GET THE FINAL MODE INFORMATION BIC #107777,R2 ;CLEAR JUNK FROM TYPE MOV R5,R0 ;GET FUTURE DATA ADDRESS MOV (R5)+,R3 ;GET THE RETURN ADDRESS MOV STKCNT,R4 ;GET FIRST DATA ADDRESS SUB038: MOV -(R4),-(R5) ;TRANSFER THE GOODIES BNE SUB038 ;UNTIL A TERMINATOR IS FOUND MOV R5,SP ;RESET STACK JMP @R3 ;RETURN TO CALLER �������������������������l�NC> .IFTF WRDSYM: DIRDEF <WORD >, DFLGDG+DFLGEV .ENDC ����������������������������������������PSTTOP: ;TOP LIMIT .END ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������m�HES MOV (SP)+,R0 ; AND DEVICE NAME (SETTING FLAGS) MOV (SP)+,R1 ;SET TERMINATOR TST R0 ;SET FLAGS RETURN OPENO: ;OPEN OUTPUT FILE SAVREG TST (R4)+ ;MOVE PAST COMMAND BUFFER POINTER MOV (R4)+,R3 ;LINK BLOCK POINTER TO R3 ; TST (R3) ;INITTED? ; BEQ 4$ ; NO MOV (R4)+,R0 ;YES, FILE BLOCK POINTER TO R0 CMP -(R0),-(R0) ;BACK UP TO ERROR SLOT MOV R0,R2 ;GET A WORKING COPY MOV #3$,(R2)+ ;IGNORE DELETION ERROR MOV #2,(R2)+ ;FLAG FOR OUTPUT MOV R2,R1 ;ASSUME NAME SPECIFIEn�P BEQ EFLD1 CMPB R4,#'- ;CHECK FOR -EXP BNE ENUM ;GO CHECK FOR NUMERIC INC ESIGN(SP) ;FLAG EXPONENT NEGATIVE EFLD1: CMP R5,END(SP) BGE ERROR EFLD2: MOVB (R5)+,R4 ;GET NEXT CHAR BIC #177600,R4 ENUM: CMPB R4,#' ;CHECK FOR BLANK BNE ENUM1 MOV #'0,R4 ;TREAT BLANK AS 0 ENUM1: CMPB R4,#'0 BLT ERROR CMPB R4,#'9 BGT ERROR ;NOT A VALID CHAR SUB #60,R4 ;CONVERT ASCII TO INTEGER ASL R3 ;X=10*X+D ADD R3,R4 ASL R3 ASL R3 ADD R4,R3 ;END OF ABOVE COMMENT CMP R5,END(SP) BLT EFLDo����������������; ; SUBROUTINE TO HANDLE ALL ARRAY SEQUENCES ; ARY000: OVRCHK ;OVERFLOW CHECK TST ARYASG BEQ ARY004 TRAP+32. ;ILLEGAL SUBSCRIPT IN ARRAY REF. ARY004: MOV R2,-(SP) ;PLACE TYPE ON STACK JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#'( ;IS THIS A NORMAL ARRAY REFERENCE? BEQ ARY001 ;YES MOV (SP)+,R2 ;GET TYPE DEC R1 ;NO ARY040: JMP SUB007 ;HANDLE LIKE SIMPLE VARIABLE ����������������������������������������ARY001: MOV IOL,-(SP) ;REMEMBER IF I/O LIST CLR IOL MOV ARYASG��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������q�D ; TST (R2) ;TRUE? ; BNE 1$ ; YES ; MOV #SRCNAM,R1 ;NO, USE SOURCE NAME 1$: MOV (R1)+,(R2)+ ;XFER NAME MOV (R1)+,(R2)+ TST (R2) ;EXPLECIT EXTENSION? BNE 2$ ; YES MOV (R4),(R2) ;NO, USE DEFAULT 2$: .DELET R3,-(R4) ;DELETE CURRENT 3$: CLR (R0) ;CLEAR ERROR ADDRESS .OPEN R3,(R4) ;OPEN THE FILE 4$: RETURN TSTSW: ;SWITCH TEST SAVREG ADD #8.,R4 ;R4 POINTED TO LINK BLOCK 1$: MOV (R4)+,R3 ;THROUGH? BEQ 6$ ; YES ADD R3,R4 ;NO, MOVE TO END OF BLOCK ADD R3,R4 MOV R4,-(r�2 ;JUMP IF MORE FIELD TO GO TST ESIGN(SP) ;CHECK EXPONENT SIGN BEQ ENUM2 ;JUMP IF IT IS + NEG R3 ;MAKE USER EXPONENT - ENUM2: ADD R3,EXP(SP) ;GET COMPLETE DECIMAL EXPONENT MOV TEMP(SP),R3 JMP SCALE ;GO SCALE THE NUMERIC PART DIV: TST R0 BLT DIV1 ;JUMP IF FRACT LEFT JUSTIFIED DIV2: DEC BEXP(SP) ;LEFT JUSTIFY NUMERIC BITS JSR PC,LEFT BPL DIV2 DIV1: MOV #16.,R4 ;SET FOR SIXTEEN ITERATIONS JSR PC,RIGHT MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) ;INITIALIZE QUOTIENT MOV R0,-(SP) DIV3s�,-(SP) ;REMEMBER ARRAY ASSIGNMENT CLR ARYASG ; FLAG MOV R0,-(SP) ;REMEMBER SERIAL NUMBER MOV R4,-(SP) ;AND VARIOUS MOV R5,-(SP) ;STACK MOV STKCNT,-(SP) ;POSITIONS MOV TEMP,-(SP) .GLOBL DIMMK,DIMWD MOV CURSYM,R0 ;GET THE MOV DIMWD(R0),-(SP) ;NUMBER OF DIMENSIONS BIC #DIMMK,@SP ;CLEAR JUNK BITS ASR @SP ;AND PUT INTO SWAB @SP ;BOTTOM OF WORD MOV SP,TEMP ;REMEMBER STARTING POINT INCB DEPTH ;ADVANCE DEPTH COUNTER JSR PC,SUBEXP ;GET FIRST SUBSCRIPT JSR PC,ARYCOM ;DIDDLE SOMEt� .TITLE RUNLNK ; ;COPYRIGHT 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; ; WRITTEN BY D. KNIGHT ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .CSECT ; .MACRO .RUN LOC MOV LOC,-(SP) EMT 65 .ENDM .MACRO .PGLOW ADDR MOV ADDR,-(SP) MOV #4,-(SP) EMT 41 .ENDM ; ;THE RUN EMT INTERFACE OCCURS IN THIS ROUTINE. ; ; WHEN A /GO IS SPECIFIED, THIS ROUTINE IS CALLED ; WHICH BUILDS A LINKER COMMAND STRING AND ; THEN INVOKES THE LINKER ; .GLOBL RUNLNKu�SP) ;MARK THE PLACE MOV -(R4),SYMBOL ;SET FOR SCAN SCANW CSIROL ;DO SO BEQ 5$ ;ERROR IF NOT IN TABLE MOV #LINBUF,R2 ;USE LINE BUFFER FOR UNPACKING 2$: MOVB #SPACE,(R2)+ ;SET DELIMITER DEC R3 ;END? BEQ 4$ ; YES MOV -(R4),CHRPNT ;SET CHARACTER POINTER DEC CHRPNT ;GET A RUNNING START 3$: GETR50 ;GET CHAR AND TEST FOR A/N BLE 2$ ; NO, THROUGH MOVB R5,(R2)+ ;OK, STUFF IT BR 3$ 4$: CLRB (R2) ;SET TERMINATOR MOV #LINBUF,CHRPNT SETNB CLR ERRBTS CLR ARGCNT ; CLR R3 v�: JSR PC,RIGHT CLC JSR PC,RIGHT MOV #2,R5 CLC DIV4: JSR PC,RIGHT ADD 6(SP),R3 ADC R2 ADC R1 ADC R0 ADD 4(SP),R2 ADC R1 ADC R0 ADD 2(SP),R1 ADC R0 ADD @SP,R0 DEC R5 ;COUNT TWICE BGT DIV4 DEC R4 BGT DIV3 ADD #8.,SP ;POP DIVIDEND SUB #3,BEXP(SP) INC EXP(SP) ;BUMP DECIMAL EXPONENT BLT DIV ;JUMP IF MORE TO DO FLOAT: DEC BEXP(SP) ;POST NORMALIZE THE RESULT JSR PC,LEFT BCC FLOAT ADD #200,BEXP(SP) ;SET EXCESS 128 BLE UNDER ;NUMBER TOO SMALL TO REPRESENT CMP w� BITS BEQ ARY002 ;JUMP IF MORE SUBSCRIPTS CMPB R2,#') ;IS THIS THE END?? BEQ ARY005 ;YES TRAP+34. ;TOO MANY SUBSCRIPTS DEC R1 ARY005: MOV #1,R2 ;YES, SPECIFY ONE SUBSCRIPT BR ARYEND ;AND CONTINUE ARY002: JSR PC,SUBEXP ;DO THE SECOND SUBSCRIPT JSR PC,ARYCOM ; DIDDLE SOME BITS BEQ ARY003 ;GO LOOK FOR ANOTHER SUBSCRIPT CMPB R2,#') ;DONE? BEQ ARY006 TRAP+34. DEC R1 ����������������������������������������ARY006: MOV #2,R2 ;SET TWO SUBSCRIPTS BR ARYEND ;TO GO ARY003: JSRx�,LOWLOC,BUFOUT,OBJLS,UNPK00 .GLOBL LINKOL,RUNCT ; RUNLNK: .PGLOW #LOWLOC ;RESET LOW LOCATION MOV #LOWLOC,SP ;RESET THE STACK POINTER MOV #BUFOUT,R1 ;GET ADDRESS OF WORK BUFFER MOV #OBJLS+6,R0 ;CHECK TST -(R0) ;FOR A BNE 1$ ;FILE TST -(R0) ;NAME BNE 1$ ;TO TST -(R0) ;USE BEQ RUNERR ;EXIT IN ERROR IF NONE 1$: MOV #OBJLS,R0 ;GET THE FILE NAME ADDRESS JSR PC,UNPK00 ;PUT OUT THE NAME ;(NO EXTENSION) MOVB #'<,(R1)+ MOV #LINKOL+6,R0 ;GET DEVICE MNEMONIC ADDRESS JSR PC,Uy�CALL @SYMBOL+2 MOV (SP)+,R4 TST ERRBTS BEQ 1$ 5$: SERROR 203 6$: RETURN CSIBAS: .ASCII /LI/ .WORD LIST .ASCII /NL/ .WORD NLIST .ASCII /N / .WORD NSWPRO CSITOP: NSWPRO: MOVB #1,NSWFLG RETURN .ENDC .SBTTL ASSEMBLER PROPER ASSEMB: ;ASSEMBLER PROPER MOV MAIN.,PRGTTL ;INIT DEFAULT TITLE MOV MAIN.+2,PRGTTL+2 MOV LCMASK,-(SP) ;STACK LISTING CONTROLS MOV LCLVL,-(SP) CALL NXTPAS ;PROCESS PASS MOV (SP)+,LCLVL MOV (SP)+,LCMASK INC PASS ;SET FOR PASS 2 NXz�BEXP(SP),#377 BGT OVER ;JUMP IF NUMBER TOO BIG CLRB R3 BISB R2,R3 SWAB R3 CLRB R2 BISB R1,R2 SWAB R2 CLRB R1 BISB R0,R1 ;MOVE OUT LOWEST ORDER BITS SWAB R1 CLRB R0 BISB BEXP(SP),R0 ;INSERT THE BINARY EXPONENT SWAB R0 ;PUT IN THE RIGHT ORDER ROR SIGN(SP) ;TEST THE ARITHMETIC SIGN JSR PC,RIGHT ;INSERT IN RESULT ADC R3 ADC R2 ADC R1 ;FINAL ROUND ADC R0 BVS OVER ;JUMP IF OVERFLOW BCS OVER STORE: TSTB ERF(SP) ;TEST REAL/DOUBLE FLAG BEQ DPREC ;JUMP IF DOUBLE ROL R2{� PC,SUBEXP ;TRY FOR THIRD ONE JSR PC,ARYCOM CMPB R2,#') ;MUST BE DONE NOW BEQ ARY007 ;OK TRAP+34. DEC R1 ARY007: MOV #3,R2 ;THREE SUBSCRIPTS ����������������������������������������ARYEND: DECB DEPTH ;RESET DEPTH COUNTER OVRCHK ;OVERFLOW CHECK BIS #101000,R2 ;SET SUBSCRIPT REFERENCE IN POLISH MOV R2,-(SP) ;PLACE IT IN THE POLISH LIST MOV TEMP,R0 ;REMEMBER WHERE JUNK IS STORED MOV R0,R3 CMPB (R0)+,R2 ;DO THE SUBSCRIPTS MATCH IN NUMBER? BEQ ARYE01 ;YES TRAP+112. ;DON'T |�NPK00 ;CONVERT IT TO ASCII SUB #3,R1 ;THE LAST 3 CHARS WERE JUNK CMPB -(R1),#' ;WAS 3RD BLANK? BEQ 2$ ;YES INC R1 ;NO 2$: MOV LINKOL+4,R3 ;GET THE SWAB R3 ;UNIT BIC #177770,R3 ;NUMBER BIS #60,R3 ;INTO R3 MOVB R3,(R1)+ ;STORE ASCII UNIT NUMBER MOVB #':,(R1)+ ;FOLLOWED BY A COLON MOV #OBJLS,R0 ;GET THE JSR PC,UNPK00 ;OBJECT FILE NAME MOV #OBJLS+4,R0 TST (R0) ;ANY EXTENSION? BEQ 3$ ;NO MOVB #'.,(R1)+ ;ADD THE JSR PC,UNPK00 ;EXTENSION SUB #3,R1 ;DISCARD JUNK CHARACT}�TPAS: CALL INIPAS ;INIT FOR PASS LINE: CALL GETLIN ;GET THE NEXT INPUT LINE CALL STMNT ;PROCESS THE STATEMENT CALL ENDLIN ;POLISH OFF LINE TST ENDFLG ;END SEEN? BEQ LINE ; NO, CONTINUE JMP ENDP INIPAS: ;INITIALIZE FOR PASS CALL CLRPAS CALL SETSRC ;INIT SOURCE ZAP SECROL ;ZAP THE SECTOR ROLL MOV R50ABS,SYMBOL ;SET ". ABS." MOV R50ABS+2,SYMBOL+2 CALL CSECTF ;MOVE ONTO ROLL CLR SYMBOL ;DITTO FOR BLANK CSECT CLR SYMBOL+2 CALL CSECTF MOV #8.,CRADIX ;SET CURRENT RA~� ;ROUND TO REAL PRECISION ADC R1 ADC R0 BVS OVER BCS OVER ;JUMP IF OVERFLOW ON ROUND MOV R0,R2 ;MOVE HIGH ORDER RESULT UP MOV R1,R3 DPREC: MOV R0,RESULT(SP) ;STORE RESULT ON STACK MOV R1,RESULT+2(SP) MOV R2,RESULT+4(SP) MOV R3,RESULT+6(SP) ADD #14.,SP ;CLEAR STACK OF JUNK MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 TSTB @SP ;TEST REAL/DOUBLE FLAG BEQ RETRN ;JUMP IF DOUBLE MOV (SP)+,2(SP) ;PUSH FLAG UP MOV (SP)+,2(SP) ;PUSH RETURN U�MATCH ARYE01: INC R0 MOV (R0)+,TEMP MOV (R0)+,STKCNT ;RESTORE MOV (R0)+,R5 ;LOCAL MOV (R0)+,R4 ;GOODIES MOV (R0)+,-(SP) ;PUT SERIAL NUMBER ON POLISH STACK MOV (R0)+,ARYASG ;RESTORE ARRAY ASSIGNMENT MOV (R0)+,IOL ;AND POSSIBLE I/O LIST MOV (R0)+,R2 ;RESTORE TYPE TOO SWAB R2 ;SHIFT OVER ASL R2 ;AT LEAST ASL R2 ;TWELVE ASL R2 ;FULL ASL R2 ;PLACES CLR -(SP) ;SET TEMPORARY TERMINATOR MOV #STRARY,-(R0) ;FUDGE IN START OF ARRAY OPERATOR JMP SUB010 ;NOW GO PACK POLISH AND C�ERS 3$: TSTB RUNCT ;DO WE NEED /CC?? BNE 4$ ;YES MOV #RUNL2,R0 ;NO BR 5$ 4$: MOV #RUNL1,R0 ;SET POINTER TO /CC 5$: MOVB (R0)+,(R1)+ ;PASS THE BNE 5$ ;LINE UNTIL END OF STRING MOV #BUFOUT,R0 SUB R0,R1 ;GET STRING LENGTH IN BYTES INC R1 ;ROUND BIC #1,R1 ;UP TO NEAREST WORD SUB R1,SP ;RESERVE SPACE ON STACK MOV SP,R1 ;SET UP NEW STRING POINTER 6$: MOVB (R0)+,(R1)+ ;TRANSFER THE STRING BNE 6$ .RUN #RUNBLK ;NOW GO LINK IT ; RUNERR: CLR -(SP) ;ISSUE MOV #1701,-(SP) ;AN �DIX COMB OBJSEC ;FAKE OUT SEQUENCE BREAK RETURN R50ABS: .RAD50 /. ABS./ R50DOT: .RAD50 /. / MAIN.: .RAD50 /.MAIN./ CLRIMP: MOV #IMPURE,R1 1$: CLR (R1)+ CMP R1,#IMPUTP BLO 1$ CLRPAS: MOV #IMPPAS,R1 1$: CLR (R1)+ CMP R1,#IMPPTP BLO 1$ CLRLIN: MOV #IMPLIN,R1 1$: CLR (R1)+ CMP R1,#IMPLTP BLO 1$ RETURN SETSRC: ;SET SOURCE FOR BEGINNING OF PASS .IF NDF XFTN MOV #CMDSAV,R1 MOV #CMDBUF,R2 CALL XMIT7 ;SET CSI BUFFER .IFTF GETSRC: ;GET THE NEXT SOURCE FILE �P RETRN: ROL (SP)+ ;FLUSH FLAG AND SET C BIT IF ERROR RTS PC ; OVER: UNDER: JMP ERROR ; MUL54: CMP R0,#146314 BLO MUL54A ;JUMP IF ROOM FOR 5/4 * FRACT CLC JSR PC,RIGHT ;DIVIDE BY 2 INC BEXP+0+2(SP) ;MULTIPLY BY 2 MUL54A: MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) CLC JSR PC,RIGHT ;HALF CLC JSR PC,RIGHT ;QUARTER BR MUL5A ;GO GET F+F/4 MUL5: MOV R0,-(SP) ;MULT BY 5 MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) JSR PC,LEFT ;DOUBLE JSR PC,LEFT ;QUADRUPLE MUL5A: A�ONTINUE ; ARYCOM: MOV #COMMAC,2(SP) ;REPLACE 0 TERMINATOR WITH COMMA OPERATOR BIC #070000,4(SP) ;CLEAR OLD MODE CONVERSION BIS #020000,4(SP) ;SET INTEGER CONVERSION JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#', ;SEE IF IT IS A COMMA RTS PC ;RETURN AND DO SOMETHING ABOUT IT ����������������������������������������; ; FUNCTION CALLS ARE HANDLED HERE. ; FUN000: OVRCHK INCB DEPTH ;ADVANCE DEPTH COUNTER MOV @SP,R3 ;COPY OF RETURN ADDRESS MOV #STRFNC,@SP ;REPLACE WITH START IF FUNCTION OPE�F301 ERROR IOT ; .NLIST BEX RUNL1: .ASCII ^/CC^ RUNL2: .ASCIZ ^,SY:FTNLIB[1,1]/L/GO^<15><12> .EVEN ; RUNBLK: 040023 ;ACTION WORD FILBLK ;FILE BLOCK LNKBLK ;LINK BLOCK 2 ;OFFSET = PGM+2 ; 0 4 FILBLK: .RAD50 /LIN/ .RAD50 /K/ 0 401 ;[1,1] 0 ; 0 LNKBLK: 0 .RAD50 /SYS/ 1 .RAD50 /SY/ 0 ;CHARLIE DAVIS' KLUDGE ; .END ���������������������������������������������������������������������������������������������������������������������������������������������������.IFT MOV #SRCLNK,R1 TST (R1) ;FILE OPEN? BEQ 1$ ; NO .CLOSE R1 ;YES, CLOSE IT .RLSE R1 .IFF MOV #LINKAS,R1 TST (R1) BEQ 2$ .CLOSE R1 2$: .IFT 1$: INIT SRC ;INIT THE SOURCE FILE MOV R1,CSISAV ;FLAG POSSIBLE TERMINATOR TST SRCFIL+4 ;EXPLICIT EXTENSION? BNE 4$ ; YES, USE IT MOV #-1,SRCFIL+4 ;NO, ASSUME ".PAL" .=.-4 .RAD50 /PAL/ .=.+2 MOV #3$,SRCFIL-4 ;SECOND CHANCE IF NOT THERE BR 5$ 3$: CLR SRCFIL+4 ;FAILED, TRY WITHOUT EXTENSION 4$: CLR SRCFIL-4 ;NO MORE�DD (SP)+,R3 ADC R2 ADC R1 ADC R0 ADD (SP)+,R2 ADC R1 ADC R0 ADD (SP)+,R1 ADC R0 ADD (SP)+,R0 RTS PC ;CODES MAY BE TESTED ON RETURN LEFT: ASL R3 ROL R2 ROL R1 ROL R0 RTS PC RIGHT: ROR R0 ROR R1 ROR R2 ROR R3 RTS PC .END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������RATOR MOV R3,-(SP) ;PUT RETURN ADDRESS BACK ON STACK MOV R2,-(SP) ;SAVE THE FUNCTION TYPE MOV R4,-(SP) ;SAVE MOV R5,-(SP) ;THE MOV STKCNT,-(SP) ;OLD MOV TEMP,-(SP) ;GOODIES MOV SP,TEMP ;REMEMBER POSITION MOV SP,R5 ;OF THE NEW GOODIES MOV #102000,-(SP) ;SET UP THE MOVB DEPTH,-(SP) ;DEPTH INDICATOR AND MOV R0,-(SP) ;FUNCTION NAME JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#'( ;IS THERE A LEFT PAREN BEQ FUN001 ;YES DEC R1 TRAP+35. ;NO ARGUMENTS MOV R5,SP ;THROW AWAY NAME M��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ERRORS ALLOWED 5$: MOV #4,SRCFIL-2 ;INPUT .OPEN #SRCLNK,#SRCFIL .IFF .OPEN #LINKAS,#ASMLS .IFTF INPSRC: ;INPUT A SOURCE BUFFER MOV #SRCBUF,R1 CLR -(R1) ;CLEAR COUNT CLR -(R1) ; AND MODE MOV #SRCLEN,-(R1) ;SET MAX LENGTH .IFT .READ #SRCLNK,R1 ;READ IT .IFF .READ #LINKAS,R1 .IFTF RETURN .ENDC GETLIN: ;GET AN INPUT LINE SAVREG CALL CLRLIN 1$: MOV #LINBUF,R2 MOV R2,LCBEGL ;SEAT UP BEGINNING MOV #LINEND,LCENDL ; AND END OF LINE MARKERS .IF NDF XMACRO ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������OV (SP)+,TEMP MOV (SP)+,STKCNT MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R2 DECB DEPTH ;RESET DEPTH OF CALL MOV (SP)+,R3 ;RETURN ADDRESS TST (SP)+ ;FORGET START OF FUNCTION OPERATOR JMP @R3 ;RETURN ����������������������������������������; SCAN FOR ARGUMENTS ; ; FIRST CONSIDER NULL ARGS ; .GLOBL NULARG FUN001: JSR PC,NXTCH ;NEXT CHAR TST R2 ;MUSTN'T BE END BEQ FUN009 CMPB #',,R2 ;, MEANS NULL ARG BEQ 1$ ;HANDLE CMPB #'),R2 ;ALSO MEANS NULL ARG BEQ 1$ DEC R1 ;NOT N� .TITLE SPCLST .IDENT /0504/ ; ; COPYRIGHT 1971, 1972, 1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY L. COHEN ; ; ;LIST ITEM PROCESSOR FOR SPECIFICATION STATEMENTS, ; ;ALSO, OTHER SPEC. STATEMENT UTILITIES. ; .CSECT .GLOBL LSTITM,FILL,GET,CURSYM,T1,T2,T3,T4,T5 .GLOBL T6,T7,T8,T9,T10,T11,T12,T13,T14,T15 .GLOBL T16,T17,T18,T19,T20 .GLOBL DIMMKM,DIMWD,PARMKM,PARWD,TYPSI�MOV MSBMRP,R1 ;ASSUME MACRO IN PROGRESS BNE 10$ ;BRANCH IF SO .IFTF MOV #SRCBUF,R1 .IF NDF XFTN .IFF .WAIT #LINKAS .IFT .WAIT #SRCLNK .ENDC TSTB SRCHDR+3 BEQ 2$ .IF NDF XFTN BIS CSISAV,ENDFLG BNE 9$ .ENDC CALL GETSRC BR 1$ 2$: MOV SRCHDR+4,R0 ;GET BYTE COUNT CLRB SRCBUF(R0) ;SET A TERMINATOR MOVBYT ;MOVE THE STRING CALL INPSRC ;ALL SET FOR THE NEXT BUFFER CMPB -(R2),#FF ;TERMINATOR A FF? BNE 3$ ; NO .IF NDF XFTN CLR LINCNT ;YES, FORCE NEW PAGE .I� .TITLE STOPAU .IDENT /0711/ ;RFB,RG ; ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; MAYNARD, MASS. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 .NLIST BEX ; ; SET TO 1 TO ALLOW ASCII STRING INPUT TO PAUSE AND STOP ; DO NOT ENABLE UNLESS OTS HAS BEEN MODIFIED TO ; ACCEPT THE SPECIAL FORM ; ASCSTR = 0 ;DO NOT ALLOW STRING FORMS .GLOBL GENLAB�ULL SO BACK UP BR FUN007 ;POINTER AND GET REAL ONE ; 1$: INC -2(R5) ;INC ARG COUNT OVRCHK MOV #NULARG,-(SP) ;PUT CODE IN POLISH CMP #'),R2 ;END OF ARGS? BEQ FUNFIN BR FUN001 ;TRY FOR MORE (POSSIBLY NULL) ; ; NORMAL ARG SCAN ; FUN007: MOV R5,-(SP) ;SAVE R5 JSR PC,SUBEXP ;GO GET A PARAMETER MOV 2(R0),R5 ;RESTORE R5 INC -2(R5) ;INCREMENT PARAMETER COUNT TST (SP)+ ;DISCARD ZERO TERMINATOR CMP R0,SP ;IS THERE ONLY ONE ITEM?? BNE FUN004 ;MORE THAN ONE MOV CURSYM,R3 ;FIND�Z,DATYWD,CNXC1 .GLOBL QADBOK,DIMENS,DATYMM,DATYMK,GETMEM,STKBAS,SCANNR .GLOBL ADBPWD,ADBCUR,MOVE,SYMNXT,SYMBAS .GLOBL TYPE,QADBOK,DIMMK,SYMEND,GENLAB .GLOBL EOL,OUTSER,PARXWD,EXPMKM,EXPWD,OUTLN,PARXMK .GLOBL SERWD,SERMK,SERATR,OUTCOM,OUTOCT,OUTTAB,GENLAB .GLOBL PSHMKM,PSHWD,GNTR$X ; R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 ; ; ;LSTITM JSR PC,LSTITM ; ;INPUTS:(R1)=1ST CHAR. TO BE SCANNED ; (R2)=LOCATION OF WHERE LSTITM SHOULD PUT ; AN ADB ;OUTPUTS:(R3)=ADDRESS OF SYMBOL T�FF MOV #60.,LINCT JSR PC,PAG .ENDC 3$: CMPB -(R2),#CR ;A VALID CR? BEQ 4$ ; YES TSTB (R2)+ ;NO, DON'T ZAP THE CHAR 4$: CLRB (R2) ;ZAP END OF LINE CHAR 5$: MOV #LINBUF,CHRPNT SETNB BR SETLIN .IF NDF XFTN 9$: ERROR E ;EOF BEFORE .END BR 4$ .ENDC .IFT 10$: CALL 20$ ;MOVE A CHARACTER BGT 10$ ;LOOP IF GT ZERO BEQ 19$ ;END IF ZERO MOVB -(R2),R0 ;TERMINATOR, BACK UP POINTER CMP R0,#MT.MAX ;END OF TYPE? BLOS 22$ ; YES MOV R1,-(SP) ;REMEMBER READ POINTER MOV MS�,ZLEQLS,CHKOCT,GOFLG .GLOBL CNXC,PAUSE,STOP,OUTLN,OUTLN1,OUTCHR,EOL .GLOBL PAUSSP ;A TEMPORARY SAVE WORD ; ; ; PAUSE AND STOP STATEMENTS ; ; ALLOWED FORMS: ; PAUSE O123456 ;OCTAL NUMBER ; PAUSE "123456 ;OCTAL CONSTANT ; PAUSE 177777 ;IMPLIED OCTAL ; PAUSE Z12AF ;HEX NUMBER ; PAUSE 'TEXT''TOO' ;TEXT STRING ; ; ; STOP O1234 ; STOP "123456 ; STOP 123456 ; STOP Z12AF ; STOP 'TEXT''TOO' ; ; .GLOBL GENLAB,ZLEQLS STOP: MOV #STOTXT,R4 ;INITIAL TEXT FO� OUT BIT #PARMKM,PARWD(R3) ;IF IT IS A FORMAL PARAMTER BNE FUN004 ;IF SO, TREAT IT LIKE MORE THAN ONE MOV (SP)+,@SP ;NOW REMOVE THE JUNK BPL FUN002 ;IT BETTER BE A VARIABLE OR CONSTANT TRAP+36. FUN002: JSR PC,NXTCH ;GET A CHARACTER CMPB R2,#', ;IS IT A SEPARATOR?? BEQ FUN001 ;YES CMPB R2,#') ;IS IT A TERMINATOR?? BEQ FUNFIN ;YES TSTB R2 ;IS IT THE END OF LINE?? BNE FUN003 ;NO FUN009: TRAP+37. ;NO CLOSING PAREN FUN003: DEC R1 ;BACK UP OVER TERMINATOR BR FUNFIN ;NOW FIN�ABLE ENTRY FOR ITEM IN LIST ; (R2)=SAME AS INPUT OR 0 IF LIST ITEM NOT ; DIMENSIONED ; (R1)=CHARACTER WHICH TERMINATED THE SCAN ; Z=0 IF AN ERROR WAS FOUND ; 1 IF NORMAL. RETURN ;NOTE: INPUT SHOULD BE A LIST ITEM (DELIMITED USUALLY ;BY COMMAS) IN A DECLARATION STATEMENT. ; LSTITM: SUB #T16,SP ;SAVE SPACE FOR TEMPS. MOV R1,(SP) ;SAVE R1,R2 IN T1,T2 MOV R2,T2(SP) CLR R3 ;ZERO OUT ADB AREA MOV R2,R4 MOV R4,R5 ADD #8.,R5 JSR PC,FILL CLR T9(SP) ;CLEAR AREA FOR POSSIBLE CLR T�BARG,R1 TST (R1)+ MOV R2,R3 ; AND WRITE POINTER NEG R0 ;ASSUME MACRO CMP MSBTYP,#MT.MAC ;TRUE? BEQ 12$ ; YES, USE IT MOV MSBCNT,R0 ;GET ARG NUMBER 12$: MOV R3,R2 ;RESET WRITE POINTER 13$: CALL 20$ ;MOVE A BYTE BGT 13$ ;LOOP IF PNZ BLT 14$ ;END IF LESS THAN ZERO DEC R0 ;ARE WE THERE YET? BGT 12$ ; NO 14$: TSTB -(R2) ;YES, BACK UP POINTER MOV (SP)+,R1 ;RESET READ POINTER BR 10$ ;END OF ARGUMENT SUBSTITUTION 19$: MOV R1,MSBMRP ;END OF LINE, SAVE POINTER BIS #LC.M�R STOP BR PAUSF PAUSE: MOV #PAUTXT,R4 ;TEXT FOR PAUSE LINE PAUSF: JSR PC,CNXC ;LOCATE NEXT NON-BLANK MOVB (R1),R2 ;LOOK AT FIRST CHAR .IFNE ASCSTR CMPB #'',R2 ;LOOK FOR ASCII CASE BEQ PAUSE2 ;YES - ASCII .ENDC ;BEFORE CHECKING OTHER CASES LOOK FOR ; ZERO LEVEL EQUAL SIGN - IF FOUND, SET V-BIT AND EXIT JSR PC,ZLEQLS ;LOOK BCC PAUSEY ;BR => NOT FOUND: ASSUME PAUSE CLRB GOFLG ;CLEAR GO FLAG SEV ;REQUEST ATTEMPT AS ASSIGNMENT RTS PC ; PAUSEY: MOV SP,PAUSSP ;SAVE SP FOR LA�ISH UP ����������������������������������������FUN004: OVRCHK MOV #104000,-(SP) ;STORE "$SVSP" SWAB R2 ;GET ASR R2 ;THE ASR R2 ;MODE IN ASR R2 ;BITS 0-2 ASR R2 ;AND BIC #177770,R2 ;SAVE IT BIS R2,@SP ;IN THE $SVSP CODE MOVB DEPTH,R2 ;GET THE DEPTH ASL R2 ;POSITION IT ASL R2 ASL R2 ;AND PLACE IT BIS R2,@SP ;BESIDE THE MODE MOV FLABL,-(SP) ;AND ITS LABEL TST (R0)+ ;UPDATE LIST START POINT MOV R0,R2 ;DELETE MOV R2,R4 ;THE TST (R4)+ ;SAVED FUN005: MOV -(R2),�15(SP) ;CLEAR ADJ ARRAY SWITCH ; ADJ. ARRAY NAME SERIAL # JSR PC,GET ;GET 1ST THING IN LIST ITEM LST02: BVS LST01 ;BR IF TROUBLE OCCURRED TST R3 ;WAS ITEM A SYMBOL? BEQ LST021 ;BR IF YES CMP #1,R3 ;ELSE, WAS ITEM AN ARRAY NAME? BNE LST01 ;BR IF NOT, ERROR. LST021: MOV CURSYM,T6(SP) ;SAVE ADDR OF POTENTIAL ARRAY NAME MOV CURSYM,R2 ;SAVE SERIAL # OF ARRAY NAME MOV SERWD(R2),T9(SP) BIC #SERMK,T9(SP) ;IF ARRAY NAME IS A PARAMETER =>THIS IS AN ADJSTBLE ARRAY BIT #PARMKM,PARWD(R2) �E,LCFLAG ;FLAG AS MACRO EXPANSION BR 5$ 20$: BIT #BPMB-1,R1 ;MACRO, END OF BLOCK? BNE 21$ ; NO MOV -BPMB(R1),R1 ;YES, POINT TO NEXT BLOCK TST (R1)+ ;MOVE PAST LINK 21$: MOVB (R1)+,(R2)+ ;MOVE CHAR INTO LINE BUFFER RETURN 22$: CMP R0,#MT.MAC ;MACRO? BNE 23$ ; NO CALL ENDMAC BR 1$ 23$: CALL ENDRPT BR 1$ .ENDC SETLIN: MOV #OCTBUF,R1 1$: MOV #SPACE*400+SPACE,(R1)+ ;BLANK FILL CMP #LINBUF,R1 ;TEST FOR END (BEGINNING OF LINE BUFFER) BNE 1$ RETURN ENDLIN: ;E�TER RECOVERY CMPB #'O,R2 ;LOOK FOR OCTAL BEQ PAUSE0 ;BR => OCTAL CMPB #'",R2 ;ALTERNATE FORM IS " BEQ PAUSE0 .IFNE ASCSTR CMPB #'Z,R2 ;LOOK FOR HEX BEQ PAUSE1 ;YES,HEX .ENDC TST R2 ;IS IT THE SIMPLE FORM? BNE PAUSEZ ;NO-ASSUME OCTAL AND HOPE JSR R5,PAUSE6 PAUST1 BR PAUSE4 ; STRING ; ; DOES NOT FIT SYNTAX OF PAUSE OR STOP ; PAUSEX: TRAP+50. ;"ILLEGAL CONSTANT IN PAUSE/STOP" JSR PC,EOL MOV PAUSSP,SP ;FIXUP SP CLV ;DON'T TRY ASSIGNMENT RTS PC ; ; COME HE�-(R4) ;TEMPORARY CMP R2,SP ;FROM BHI FUN005 ;THE STACK MOV R4,SP ;RESET THE STACK POINTER SUB R4,R0 ;GET COUNT-2 TO TRANSFER MOV R4,R3 ;GENERATE SUB R0,R3 ;THE DESTINATION ADDRESS MOV R3,R2 ;REMEMBER THE ADD R0,R2 ;ADDRESS OF THE POLISH TO BE MOVED ; ADJUST R3 TO BE ADDRESS OF POLISH TO BE ; MOVED AND CHECK FOR OVERFLOW POSSIBILTY SUB #2,R3 CMP R3,MTOP BLOS EXPERR ;OVERFLOW IS FATAL! MOV R3,SP ;RESET THE STACK TO MAKE ROOM FUN006: MOV (R4)+,(R3)+ ;FILL OUT THE STAC� BEQ LST022 ;BR IF NOT A PARAMETER INC T15(SP) ;ELSE SET ADJ. ARRAY INDICATOR LST022: CMPB (R1),#'( ;WAS TEMR. LEFT PAREN? BEQ LST10 ;BR IS YES, DIMENSIONING BR LST11 LST01: TRAP+17. ;ELSE, SYNTAX NO GOOD. LST010: ADD #T16,SP ;RELEASE TEMPS CLZ ;Z=0, BAD SYNTAX RTS PC LST11: CLR R2 ;RETURN A SINGLE VARIABLE MOV CURSYM,R3 ADD #T16,SP ;RELEASE TEMPS SEZ RTS PC LST10: ;GET UP TO 3 DIMENSIONING ITEMS ;PUT TYPE, SIZE IN ADB MOV T2(SP),R2 ;ADB BASE TST (R2)+ ;BUMP R2 TO POINT�ND OF LINE PROCESSOR SAVREG CLR ROLUPD CLR LOUTR ;CLEAR LISTING REQUEST TST R5 ;BRANCH IF END OF LINE BEQ 1$ CMP R5,#CH.SMC ; ";" BEQ 1$ ERROR Q 1$: TST PASS ;PASS 1? BEQ 20$ ; YES TST ERRBTS ;ANY ERRORS? BNE 10$ ; YES, GO DIRECTLY, DO NOT COLLECT, ETC. .IF DF XFTN CMP LSTVAL,#2 ;LISTING REQUESTED? BGE 13$ ;YES, GO DO IT .ENDC TST LCLVL ;TEST OVER-UNDER RIDE BLT 20$ ;IF <0, LIST ONLY IF ERRORS BGT 13$ ;IF >0, LIST UNCONDITIONALLY .IF NDF XFTN BIT #LC.CO�RE TO CLOSE OFF A NORMAL (AND CORRECT) ; OUTPUT LINE BY APPENDING THE CLOSING ' (PRIME) ; AND TERMINATING ".BYTE 0" AND ".EVEN" ; PAUSE3: MOV #PAUST5,R4 ;POINTER TO THE TEXT JSR PC,OUTLN1 ;TO BINARY PAUSE4: CLV ;EXIT HAPPY RTS PC ���������������������������������������� ; ; ASSUMED OCTAL CASE (NO INITIAL "O") ; PAUSEZ: DEC R1 ;BACK UP R1 TO LEAVE FULL CONSTANT ; ; OCTAL CONSTANT CASE ; PAUSE0: JSR R5,PAUSE6 ;INITIAL TEXT OUT PAUST0 MOV #CHKOCT,R3 ;OCTAL CHECK ROUTINE MOV�K TO MAKE CMP R4,R5 ; ROOM FOR THE BLO FUN006 ; POLISH TO BE MOVED MOV R2,R3 ;NOW PLACE FUN008: MOV -(R2),-(R4) ; THE POLISH CMP R2,SP ; IN THE MIDDLE BHI FUN008 MOV R3,SP ;NOW CLOSE UP THE STACK TO SAVE SPACE MOV FLABL,-(SP) ;SAVE LABEL ON PARAMETER LIST INC FLABL ;ADVANCE THE LABEL POINTER BIS #170000,@SP ;SET LABEL PRESENT FLAG MOV R4,R5 BR FUN002 ;GO GET NEXT ARGUMENT ����������������������������������������FUNFIN: MOV TEMP,R3 ;RESTORE MOV R3,R2 MOV (R3)+,TEMP ;AL� TO WORD 1 MOV T6(SP),R3 ;ENTRY BASE,ARRAY NAME MOV DATYWD(R3),R4 MOV R4,(R2) ;TYPE INTO ADB SWAB R4 ;ISOLATE TYPE ASR R4 ASR R4 ASR R4 ;USE AS INDEX INTO SIZE TABLE BIC #177770,R4 MOVB TYPSIZ(R4),(R2) TST (R2)+ ;STEP ADB POINTER TO 1ST DIM. WD CLR R4 ;DIMENSION=0 MOV R2,R5 ;INITIALIZE PTR TO ADB MODEL FOR HANDLING ;ADJUSTABLE ARRAYSS MOV SP,T13(SP) ADD #T10,T13(SP) MOV T13(SP),T14(SP) ;SAVE PTR TO T10 TWICE CLR T10(SP) CLR T11(SP) CLR T12(SP) ���������������������M,LCMASK ;COMMENT SUPPRESSION? BEQ 2$ ; NO MOV CHRPNT,LCENDL ;YES, ASSUME WE'RE SITTING AT COMMENT 2$: BIT #LC.SRC,LCMASK ;LINE SUPPRESSION? BEQ 3$ ; NO MOV #LINBUF,LCENDL ;YES, POINT TO START OF BUFFER 3$: TSTB ROLSIZ+CODROL+1 ;ANYTHING IN CODE ROLL? BEQ 4$ ; NO BIT #LC.MEB,LCMASK ;MACRO BINARY EXPANSION? BNE 4$ ; NO BIC #LC.ME,LCFLAG ;YES, IGNORE ME FLAG 4$: BIT LCMASK,LCFLAG ;ANYTHING SUPPRESSED? BNE 20$ ; YES, DON'T LIST .ENDC BR 19$ ;YES 10$: INC ERRCNT ;BUMP E� #6,R0 ;AT MOST 6 CHARS IN OCTAL CONST JSR PC,PAUS01 ;OUTPUT OCTAL CONST AS TEXT TST R0 ;EXACTLY SIX CHARS?? BGT PAUSE3 ;NO - ALL IS WELL ;IF SIX CHAR THEN FIRST MUST BE 0 OR 1 CMPB R2,#'1 ;IS FIRST 0 OR 1?? BGT PAUSEX ;TOO BIG IS AN ERROR BR PAUSE3 ;ALLS WELL THAT ENDS WELL! ; ; OUTPUT OCTAL AND HEX CONSTANTS AS TEXT ; R0 = MAX CHAR COUNT ; R3 = CHAR CHECK ROUTINE ; PAUS01: INC R1 ;SKIP PAST O/Z JSR PC,CNXC ;FIRST LETTER MUST NOT BE EOL BEQ PAUSEX ;ERROR IF EOL MOV�L MOV (R3)+,STKCNT ;THE MOV (R3)+,R5 ;GOODIES MOV (R3)+,R4 ;NOW CLR -(SP) ;SET A TERMINATOR MOV (R3)+,R0 ;GET THE FUNCTION TYPE MOV (R3)+,-(SP) ;GET THE RETURN ADDRESS FUNF01: MOV -(R2),-(R3) ;PACK THE BNE FUNF01 ;TEXT TST (R3)+ ;DISCARD TERMINATOR MOV R0,R2 ;PUT TYPE IN R2 MOV (SP)+,R0 ;GET RETURN ADDRESS MOV R3,SP ;RESET THE STACK MOV #100400,-(SP) ;SET END OF FUNCTION CLR -(SP) ;SET ZERO TERMINATOR DECB DEPTH ;RESET DEPTH JMP @R0 ;RETURN TO CALLER ����������������������������������� LST15: JSR PC,CNXC1 ;GET NEXT NONBLANK CH. CMP R4,#3 ;HAVE WE GOT 3 DIM? BEQ LST23 ;BR IF YES LST16: JSR PC,GET ;NOT YET. GET NEXT THING. LST17: BVS LST26 ;BR IF TROUBLE OCCURRED LST18: TST R3 ;WAS ITEM A SYMBOL BNE 1$ JMP LST50 ;BR IF YES 1$: CMP R2,#2 ;ELSE, WAS IT AN INTEGER? BNE LST26 ;BR IF NO, ILLEGAL TST R0 ;ELSE WAS INT. POS DEF? BLE LST26 ;BR IF NOT LST20: MOV R0,(R5) ;ELSE FILL LST201: TST (R5)+ ;BUMP ADB POINTER INC R4 ;BUMP DIMENSION COUNT�RROR COUNT INCB LOUTR ;LIST TO KB BICB NSWFLG,LOUTR MOV #ERRMNE-1,R1 MOV #OCTBUF,R2 11$: TSTB (R1)+ ;MOVE CHAR PNTR AND CLEAR CARRY ROR ERRBTS ;ROTATE ERROR BITS BCC 12$ MOVB (R1),(R2)+ 12$: BNE 11$ 13$: MOV #LINBUF,LCBEGL ;LIST ENTIRE LINE MOV #LINEND,LCENDL 19$: MOVB LOUTF+1,LOUTR+1 ;SET LISTING FLAG 20$: CALL PCROLL 21$: TST LOUTR ;ANYTHING REQUESTED? BEQ 24$ ; NO CLRB @LCENDL ;SET ASCIZ TERMINATOR MOV LCBEGL,R1 MOV #LINBUF,R2 CMP R1,R2 ;ANY SHIFTING? BEQ 23$ �B @R1,R2 ;SAVE FIRST DIGIT TO BE LOOKED ;AT AFTER RETURN FROM 'PAUS01' PAUS02: JSR PC,@R3 ;CHECK AS OCTAL/HEX BVS PAUSEX ;ERROR - BAD CHAR DEC R0 ;COUNT THIS CHAR BMI PAUSEX ;BR => TOO MANY CHARS MOVB (R1)+,R4 ;GET THE CHAR FOR OUTPUT JSR PC,OUTCHR ;OUTPUT ONE CHAR JSR PC,CNXC ;FIND NEXT CHAR BEQ PAUS03 ;EOL => NORMAL EXIT BR PAUS02 ;BACK FOR MORE PAUS03: RTS PC ;EXIT WITH ALL OKAY ; ; HEX CONSTANT CASE ; ; .IFNE ASCSTR ; PAUSE1: JSR R5,PAUSE6 ;INITIAL TEXT OUT ��������������������������� ; ROUTINES TO CHECK FOR OVERFLOW ERRORS ; EXPERR: JMP EXPSTK ;TAKE THE FATAL RETURN ; ; CALL 'GET' AFTER MAKING SURE IS ENOUGH ROOM ; FOR IT TO USE ON STACK ; GETCHK: MOV R1,-(SP) MOV MTOP,R1 ;MTOP IS LOW CORE LIMIT ADD #140.,R1 ;GET CAN USE A LOT OF STACK CMP R1,SP ;CHECK STACK BHIS EXPERR ;STACK OVERFLOW MOV (SP)+,R1 ;OKAY TO PROCEED JSR PC,GET RTS PC ; ; CHECK FOR AT LEAST 15 WORDS OF STACK ROOM ; BEFORE PUSHING ANYTHING NEW ON IT ; OV�ER ADD #2,T13(SP) ;BUMP ADB MODEL PTR LST211: CMPB (R1),#', ;WAS TERM. A COMMA? BEQ LST15 ;BR IF YES, GET NXT DIM LST23: CMPB (R1),#') ;ELSE, WAS TERM A RT PAREN? BNE LST25 ;BR IF NOT INC R1 ;STEP PAST RIGHT PAREN ;IF YES, CLOSE OUT LST24: MOV T2(SP),R2 ;RESTORE R2, BASE OF ADB ROR R4 ;ISOLATE DIMENSION CT, ROR R4 ;PUT INTO ADB ROR R4 BIC #037777,R4 ;CLEAR SOURCE FIELD BIC #140000,2(R2) ;CLEAR DEST. FIELD BIS R4,2(R2) TST T15(SP) ;IS THIS AN ADJUSTABLE ARRAY? BEQ LST241 ;BR I� ; NO 22$: MOVB (R1)+,(R2)+ ;MOVE IT OVER BNE 22$ 23$: LSTLIN OCTBUF ;LIST THE LINE 24$: CALL SETLIN CALL PCROLL BEQ ENDLIF ;EXIT IF EMPTY CLR @LCBEGL .IF NDF XFTN BIT #LC.BEX,LCMASK ;BINARY EXTENSION SUPPRESSED? BEQ 21$ ; NO .ENDC BR 24$ ;YES, DON'T LIST ENDLIF: ZAP CODROL ;CLEAR THE CODE ROLL RETURN .SBTTL STATEMENT PROCESSOR STMNT: .IF NDF XFTN TST CNDWRD ;IN CONDITIONAL? BNE 20$ ; YES, BRANCH IF SUPPRESSED .ENDC GETSYM BEQ 6$ CMP R5,#CH.COL ; "�PAUST0 MOV #CHKHEX,R3 ;HEX CHECK ROUTINE MOV #4,R0 ;AT MOST FOUR CHAR JSR PC,PAUS01 ;OUTPUT THE HEX (NOT THE WHAMMY!) BR PAUSE3 ;ALLS WELL ... ; .ENDC ; ; ; ASCII STRING CASE ; ; .IFNE ASCSTR ; PAUSE2: INC R1 ;STEP PAST OPENING ' JSR R5,PAUSE6 ;INITIAL TEXT PAUST0 PAUS21: MOVB (R1)+,R4 ;TST FOR EOL BEQ PAUSEX ;DIDN'T TERMINATE THE STRING CMPB #'',R4 ;LOOK FOR EMBEDDED ' BEQ PAUS23 PAUS22: JSR PC,OUTCHR BR PAUS21 ;GET MORE ; PAUS23: MOVB (R1)+,R4 ;HAVE ONE PRIME �RCHK: MOV R1,-(SP) ;WHAT A WAY TO START! MOV MTOP,R1 ;MTOP IS LOW CORE LIMIT ADD #30.,R1 ;AT LEAST 30 BYTES MUST REMAIN CMP R1,SP BHIS EXPERR ;STACK OVERFLOW MOV (SP)+,R1 RTS PC .END ���������������������������������������� ���������������������������������������� ���������������������������������������� ���������������������������������������� ���������������������������������������� ���������������������������������������� ���������������������������������������� ����������������������F NOT JSR PC,GNTR$X ;FLAG NEW $T,$SNNNN MAYBE NEEDED JSR PC,GENLAB ;ELSE OUTPUT TRACE CODE MOV #LST901-LST899,R5 ;OUTPUT GLOBL AND CALL MOV #LST899,R4 ;TO $ADJ (ADJ. ARRAY INITIALIZER) JSR PC,OUTLN MOV #LST90A-LST900,R5 MOV #LST900,R4 JSR PC,OUTLN JSR PC,OUTCOM MOV T9(SP),R0 ;GET SERIAL # OF ARRAY NAME ;NOTE - SER. # OF ARRAY NAME PREFIXED WITH "$A" ;IS THE SYMBOL FOR THE ARRAY'S ADB AT OBJECT TIME JSR PC,SERATR MOV CURSYM,R0 BIS #PSHMKM,PSHWD(R0) MOVB #'A,R0 ;OUTPUT SYMBOLI�:" BEQ LABEL CMP R5,#CH.EQU ; "=" BEQ ASGMTP .IF NDF XMACRO MSRCH BNE 11$ .ENDC OSRCH BEQ 7$ 1$: MOV #CLCLOC,R4 ;SET POINTER FOR USE OF ALL DIRECTIVES BIT #100000+DFLGEV,MODE ;FORCED EVEN OR OP-CODE? BEQ 2$ ; NO BIT #1,(R4) ;YES, ARE WE EVEN? BEQ 2$ ; YES INC (R4) ;NO, MAKE IT SO ERROR B ; AND FLAG "B" ERROR 2$: CLR R0 ;CLEAR FOR SUBROUTINES USE CLR R3 ; DITTO MOV MODE,R1 ;GET OP'S CHARACTERISTICS BMI 10$ ;BRANCH IF OP-CODE FLAG SET BIT #DFLGDG,R1 ;DATA�- ANOTHER? CMPB #'',R4 BEQ PAUS22 ;BR => YES - INCLUDE ONE IN STRING BR PAUSE3 ;OTHERWISE TERMINATE ; .ENDC ; ; ; OUTPUT THE INITIAL TEXT ; PAUSE6: JSR PC,GENLAB ;GENERATE LABEL IF ANY HERE CMP R4,#STOTXT ;IS THIS A STOP? BNE PS6A ;NO INCB GOFLG PS6A: JSR PC,OUTLN1 ;"$PAUSE" OR "$STOP" MOV (R5)+,R4 JSR PC,OUTLN1 RTS R5 ; ; PIECES OF THE TEXT ; PAUTXT: .ASCII / .GLOBL $PAUSE/ .BYTE CR,LF .BYTE TAB .ASCII "$PAUSE" .BYTE 0 ; STOTXT: .ASCII / .GLOBL $STOP/ .���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������C NAME OF ADB MOV T9(SP),R3 ;GET SERIAL AGAIN JSR PC,OUTSER JSR PC,OUTCOM ;WRITE A COMMA ;NEXT GET THE PARAMETER INDEX OF THE ARRAY NAME ;AND OUTPUT IT TO THE OBJECT DEVICE. MOV T6(SP),R3 ;WE CAN ASSUME THAT THE MOV PARXWD(R3),R3 ;ARRAY NAME IS INDEED A BIC #PARXMK,R3 ;PARAMETER SINCE IT WAS JSR PC,OUTOCT ;CHECKED FOR AT LST502: MOV #3,R5 ;INITIALIZE LOOP COUNT MOV T14(SP),R4 ;GET ADDR OF ADB MODEL LST243: MOV R4,-(SP) ;PROTECT R4 FROM "OUTCOM" JSR PC,OUTCOM ;OUTPUT A COMMA MOV (S� GENERATING TYPE? BNE 3$ ; YES JMP @VALUE ;NO, JUST BRANCH 3$: MOV (R4),-(SP) ;YES, SAVE CURRENT PC CALL @VALUE ;CALL PROPER ROUTINE MOV (SP)+,(R4) ;RESTORE INITIAL PC 5$: RETURN 6$: MOV #10.,R2 ;NOT SYMBOL, PERHAPS LOCAL SYMBOL? CVTNUM BEQ 7$ ; NO CMP R5,#CH.DOL ;NUMBER, TERMINATED BY "$"? BNE 7$ ; NO GETNB CMP R5,#CH.COL BNE 7$ LSRCH ;YES, DO A LOCAL SYMBOL SEARCH BR LABELF ;EXIT THROUGH LABEL PROCESSOR 7$: SETSYM ;RESET CHAR POINTER AND FLAGS BEQ 5$ ;�BYTE CR,LF .BYTE TAB .ASCII "$STOP" .BYTE 0 ; PAUST0: .BYTE CR,LF,TAB .ASCII ".ASCII" .BYTE TAB,ASCDLM,0 ; PAUST5: .BYTE ASCDLM PAUST1: .BYTE CR,LF,TAB .ASCII ".BYTE 0" .BYTE CR,LF,TAB .ASCII ".EVEN" .BYTE CR,LF,0 ; .EVEN ASCDLM ='^ ;USE ^ FOR ASCII DELIMITER CR =015 ;CARRIER RETURN LF =012 ;LINE-FEED TAB =011 ;HORIZONTAL TAB .END ��������������������������������������������������������������������������������������������������������������������������������������� .TITLE STRTUP ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; ; WRITTEN BY D. KNIGHT ; MODIFIED 1 NOV 72 TO ADD 'NOOVL' CONDITIONAL ; FOR CORE RESIDENT COMPILER. ; MODIFIED 28 NOV 72 TO ADD SUPPORT OF 512 WORD ; BLOCK SIZE FOR RP03 ; .MCALL .INIT,.STAT,.LOOK,.TRAN,.WAIT,.DTCVT ; .GLOBL RSET,DPTR,DIFILE,FORTRN,DGBLK .GLOBL VERSON,VER1,VER2 ; ; THIS ROUTINE GETS THE OVERLAY GOODIES SET UP SO THAT THEY ; ARE USEABLE WITHOUT WASTING OODLES OF TIME. THIS ROUTINE ; IS WIPED OUT BY THE �P)+,R4 ;GET R4 BACK MOV (R4)+,R0 ;GET SERIAL # OF NEXT DIM. BEQ LST242 ;IF 0 ISSUE A "-1" MOV R4,-(SP) ;PROTECT R4 JSR PC,SERATR ;ELSE GET PARAMETER FROM SYMBOL TABLE MOV CURSYM,R0 MOV PARXWD(R0),R3 ;GET RID OF UNWANTED BITS BIC #PARXMK,R3 JSR PC,OUTOCT ;CONVERT TO ASCII & WRITE OUT MOV (SP)+,R4 ;GET R4 BACK LST245: DEC R5 ;REDUCE LOOP COUNT BNE LST243 LST244: JSR PC,EOL ;WRITE <CR,LF> MOV T2(SP),R2 ;RESTPRE ADB PTR TO R2 LST241: MOV T6(SP),R3 ;DELIVER CUR. SYMBOL MOV R3,CURSYM �NULL IF END OF LINE CMP R5,#CH.SMC ; OR COMMENT (;) BEQ 5$ MOV #WRDSYM,R1 ;NEITHER, FUDGE ".WORD" DIRECTIVE MOV #SYMBOL,R2 CALL XMIT4 ;MOVE PST ENTRY TO "SYMBOL" BR 1$ 10$: JMP PROPC .IF NDF XMACRO 11$: JMP MCALL .ENDC .IF NDF XFTN 20$: CALL SETCLI ;UNSAT CONDITIONAL, TEST DIRECTIVE BMI 22$ ; BRANCH IF EOF BIT #DFLCND,R0 ;CONDITIONAL? BNE 1$ ; YES, PROCESS IT BIS #LC.CND,LCFLAG ;MARK AS UNSAT CONDITIONAL 22$: CLR R5 RETURN ;IGNORE LINE .ENDC .IF NDF XMACRO���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ROUTINE IT LOADS, SO DON'T TRY ; TO FIND IT ONCE IT IS DONE. ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; .CSECT ; ; THE WHOLE FORTRAN WORLD STARTS UP HERE WHEN THIS HAPPENS. ; .IF NDF NOOVL ;THIS SECTION FOR OVERLAY COMPILER - NORMAL CASE .GLOBL FB0,LOWLOC,TLB,OVTAB,LENGTH,RDCNTX .GLOBL OV0,OVLIST,DIVX NOFILE: CLR -(SP) ;GIVE F300 ERROR MOV #1700,-(SP) ;FOR BAD IOT ;OVERLAY FILE FORTRN: .INIT #TLB ;INIT THE TRAN DEVICE .STAT #TLB ;GET THE DEVIC� ADD #T16,SP ;RELEASE TEMPS. SEZ ;Z=1 RTS PC LST26: TRAP+16. ;DIAG "ILLEGAL SYNTAX IN DIM. SPEC." MOV #1,(R5) ;DEFAULT DIMENSION SIZE=1 BR LST201 LST25: TRAP+115. ;DIAG, "DIMENS. NOT TERM BY RIGHT PARAN". MOV T2(SP),R2 ;RESTORE R2 MOV T6(SP),R3 ;FIX UP CURSYM MOV R3,CURSYM ADD #T16,SP ;RELEASE TEMPS CLZ RTS PC LST242: MOV #-1,R3 ;OUTPUT A -1 MOV R4,-(SP) JSR PC,OUTOCT MOV (SP)+,R4 BR LST245 ;HANDLE ADJUSTABLE ARRAY ITEM LST50: LST501: CLR (R5) ;SET NEXT ADB DIM=0 � GETMLI: ;GET MACRO-TYPE LINE CALL GETLIN ;GET A LINE BIS #LC.MD,LCFLAG ;FLAG AS MACRO DEFINITION .ENDC SETCLI: 1$: GETSYM ;TRY FOR SYMBOL BEQ 4$ ; EXIT IF NO SYMBOL CMP R5,#CH.EQU ;ASSIGNMENT (=)? BEQ 3$ ; YES, IGNORE THIS LINE CMP R5,#CH.COL ;LABEL (:)? BNE 2$ ; NO GETNB ;YES, BYPASS COLON BR 1$ ; AND CONTINUE 2$: OSRCH ;TRY FOR OP-CODE MOV MODE,R0 ;MODE TO R0 BPL 4$ ;BRANCH IF DIRECTIVE 3$: CLR R0 ;FALSE 4$: RETURN ASGMTP: BR ASGMT LABEL: ;� .TITLE SUBFUN ; ;COPYRIGHT 1971, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; .GLOBL FUNCTI,FUNCTO,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 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; TAB = 11�E STATUS CMP (SP)+,(SP)+ ;JUNK UNNEEDED STUFF MOV (SP)+,BLKSIZ ;AND SAVE THE BLOCK SIZE .LOOK #TLB,#FB0,1 ;LOOK UP FILE CHARACTERISTICS MOV #OV0,R1 ;GET ADDRESS OF TRANSFER BLOCK MOV (SP)+,@R1 ;REMEMBER THE START ADDRESS MOV (SP)+,R5 ;GET BLOCK COUNT CMP BLKSIZ,#256. ;IS THIS THE BIG BLOCK SIZE? BEQ FORT2A ;BR => 256. BMI FORT3A ;BR => 64. ASL R5 ;THIS IS 512. FORT2A: ASL R5 ;CONVERT TO ASL R5 ;SEGMENT COUNT FORT3A: MOV R5,BLKCNT ;SAVE THE BLOCK COUNT FOR LATER CHECKING BIC #17� LST502: MOV CURSYM,R3 ;IS THIS ITEM A PARAMETER? BIT #PARMKM,PARWD(R3) BEQ LST504 ;BR IF NOT MOV T6(SP),R3 ;ELSE IS ARRAY NAME A PARAM? BIT #PARMKM,PARWD(R3) BEQ LST504 ;BR IF NOT, ERROR ;ELSE DEPOSIT SERIAL # OF THIS ITEM IN MODEL ADB LST503: MOV CURSYM,R3 MOV SERWD(R3),@T13(SP) BIC #SERMK,@T13(SP) INC T15(SP) ;SET ADJ ARRAY SW TO NON 0 JMP LST201 LST504: TRAP+22. ;DIAG: "ADJ. ARRAY NAME OR INDX ITEM MUST BE PARAM" BR LST503 ;PRETEND IT WAS OK ; LST899: .ASCII / .GLOBL/ LST90�LABEL PROCESSOR CMP SYMBOL,R50DOT ;PERIOD? BEQ 4$ ; YES, ERROR INC LSYFLG ;FLAG START OF NEW LOCAL SYMBOL BLOCK SSRCH ;NO, SEARCH THE SYMBOL TABLE LABELF= . BIT #DEFFLG,FLAGS ;ALREADY DEFINED? BNE 1$ ; YES MOV CLCFGS,R0 ;NO, GET CURRENT LOCATION CHARACTERISTICS BIC #377-<RELFLG>,R0 ;CLEAR ALL BUT RELOCATION FLAG BIS #DEFFLG!LBLFLG,R0 ;FLAG AS LABEL BIS R0,MODE ;SET MODE MOV CLCLOC,VALUE ; AND CURRENT LOCATION BR 3$ ;INSERT 1$: BIT #LBLFLG,FLAGS ;DEFINED, AS LABEL? B� ; 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 ;CHECK MODE, IS IT CORRECT? BNE BADSUB ;NO BIS #NAMMKM,NAMWD(R0) ; SET NAME FLAG TST PARCNT ;IS THIS A SPECIAL �7477,(SP) ;CLEAR UNNEEDED BITS CMP (SP)+,#300 ;DOES FILE EXIST AND IS IT CONT.? BNE NOFILE ;FILE IS BAD-BAD-BAD?!!! MOV #LENGTH,OV0+2 MOV #RDCNTX,OV0+4 .TRAN #TLB,R1 ;READ IN THE CONTROL BLOCK .WAIT #TLB ;WAIT FOR COMPLETION CMP BLKCNT,LENGTH ;IS THIS THE CORRECT LENGTH? BLT NOFILE ;NO, VERY-VERY BAD CMP OVTAB+2,#LOWLOC ;DOES OVERLAY ADDRESS MATCH???? BNE NOFILE ;NO, CANNOT BE CORRECT FILE MOV #OVTAB,R0 ;GET CONTROL BLOCK ADDRESS MOV OV0,R1 ;GET THE ADDRESS FUDGE MOVB OVLIS�0: .ASCII / $ADJ/ LST90A: .BYTE 015,012 ;<CR,LF> LST901=. .EVEN ����������������������������������������; ; ;DIMENS DIMENSION STATEMENT PROCESSOR ; ; DIMENS: TSTB ALOKAT .GLOBL ALOKAT BGT DIMERR SUB #T15,SP ;RESERVE TEMPS MOV #1,T3(SP) ;SET ENTRY SW. TO "DIMENSION" BR DIM01 DIMERR: TRAP+108. ;CAN'T OCCUR AFTER DATA RTS PC ; ; ; ;TYPE PROCESSOR--SHARES COMMON CODE WITH ;"DIMENSION" ;ON ENTRY THE EXPLICIT DATA TYPE MUST BE IN THE ;LOW ORDER 3 BITS OF R0 ; ; TYPE: TSTB AL�EQ 2$ ; NO, INVALID CMP CLCLOC,VALUE ;HAS ANYBODY MOVED? BNE 2$ ; YES CMPB CLCSEC,SECTOR ;SAME SECTOR? BEQ 3$ ; YES, OK 2$: ERROR P ;NO, FLAG ERROR BIS #MDFFLG,FLAGS ;FLAG AS MULTIPLY DEFINED 3$: INSERT ;INSERT/UPDATE SETPF0 ;BE SURE TO PRINT LOCATION FIELD BR 5$ 4$: ERROR Q 5$: GETNB ;BYPASS COLON MOV CHRPNT,LBLEND ;MARK AND OF LABEL JMP STMNT ;TRY FOR MORE .SBTTL ASSIGNMENT PROCESSOR ASGMT: GETNB ;BYPASS "=" MOV #SYMBOL+4,R1 ;SET MIX-MASTER REGISTER MO�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 DEC 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 ; FAK�T+1,R2 ;GET INC R2 ;COUNTER FORT4A: MOV (R0),R3 ;GET SEGMENT ADDRESS CMP BLKSIZ,#256. ;IS THIS THE BIG BLOCK? BEQ FORT5B ;BR => 256. BMI FORT5A ;BR => 64. ASR R3 ;THIS IS 512. FORT5B: ASR R3 ;YES, CONVERT TO ASR R3 ;DISK ADDRESS FORT5A: ADD R1,R3 ;GET ACTUAL DISK ADDRESS MOV R3,(R0)+ ;STORE IT ADD #4,R0 ;ADVANCE TO NEXT ENTRY DEC R2 ;SEQUENCE THROUGH BNE FORT4A ;ALL OF THE ENTRIES .IFF ; START HERE FOR NON-OVERLAY COMPILER FORTRN: .ENDC ; ; NOW WE KNOW ALL ABOUT TH�OKAT BGT DIMERR SUB #T15,SP ;RESERVE SOME TEMPS CLR T3(SP) ;SET ENTRY SW TO "TYPE" DIM01: MOV R4,(SP) MOV R5,T2(SP) MOV R0,T4(SP) ;PUT ACTUAL TYPE IN T4 MOV R1,T5(SP) ;SAVE START OF STRING IN CASE ;OF ERROR MOV SP,R2 ;COMPUTE ADDR OF ADB WORK AREA, ;T6-T10 ADD #T6,R2 MOV R2,T11(SP) ;SAVE ADDR OF ADB WRK AREA KER01: JSR PC,LSTITM ;LOOK AT NEXT LIST ITEM BNE KER11 ;WAS IT OK? BR IF NOT KER03: TST R2 ;ELSE WAS ITEM PREV. DIM'D? BNE KER02 ;BR IF SO ;ELSE IF THIS IS "TYP�V -(R1),-(SP) ;STACK SYMBOL MOV -(R1),-(SP) RELEXP ;GET NON-EXTERNAL EXPRESSION SETPF1 ;SET LISTING FIELD MOV (SP)+,(R1)+ ;RESTORE SYMBOL MOV (SP)+,(R1)+ BIT #ERR.U,ERRBTS ;ANY UNDEFINED'S? BNE 3$ ; YES, DON'T DEFINE CMP SYMBOL,R50DOT ;MESSING WITH THE PC? BEQ 1$ ; YES BIS #DEFFLG,(R1) ;FLAG AS DEFINED MOV (R1)+,-(SP) ;NO, STACK VALUE MOV (R1)+,-(SP) SSRCH ;SEARCH SYMBOL TABLE MOV (SP)+,-(R1) ;RESTORE VALUE BIC #-1-GLBFLG,-(R1) BIS (SP)+,(R1) INSERT ;INSERT NE�E 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 #PARMKM,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�E VARIOUS ROUTINES ; .INIT #DGBLK ;INIT DIAGNOSTIC FILE .STAT #DGBLK ;GET BLOCK SIZE CMP (SP)+,(SP)+ ;NOT NEEDED MOV (SP)+,BLKSIZ ;GOT IT .LOOK #DGBLK,#DIFILE,1 ;LOOK UP ERROR FILE MOV (SP)+,DPTR ;SAVE BLOCK NUMBER MOV BLKSIZ,DPTR+2 ;AND ASL DPTR+2 ; BLOCK SIZE TST (SP)+ BIC #177477,(SP) ;CLEAR JUNK BITS CMP (SP)+,#300 ;DOES FILE EXIST AND IS IT CONTIGUOUS? BNE NODGN ;IT IS A BAD FILE EXIT: .IF NDF COM8K .GLOBL DTE .DTCVT #DTE ;GET THE ASCII DATE .ENDC ; ; ONCE O�E" PROCESSING - OVERRIDE ;SIZE & TYPE IN ADB. BIT #DIMMKM,DIMWD(R3) ;IS THIS DIMENSIONED? BEQ KER09 ;NO MOV ADBPWD(R3),R2 ;GET ADDRESS ADD SYMBAS,R2 ;OF REAL ADB KER02: TST T3(SP) ;IS THIS "TYPE" PROC. BNE KER04 ;BR IF NOT MOV T4(SP),R4 ;ELSE GET CORRECT SIZE MOVB TYPSIZ(R4),2(R2) ; SWAB R4 ;MANUEVER TYPE ASL R4 ASL R4 ASL R4 BIC #DATYMK,R4 ;INTO ADB BIC #DATYMM,2(R2) BIS R4,2(R2) KER04: JSR PC,QADBOK ;IF DIM'D, CHK NEW AND OLD ADB'S KER05: BVS KER08 ;BR IF NOT SAME K�W VALUE RETURN 1$: TSTB (R1)+ ;PC, MOVE PAST FLAGS CMPB (R1)+,CLCSEC ;SAME SECTOR? BNE 2$ ; NO, ERROR MOV (R1)+,CLCLOC ;YES, SET NEW LOCATION RETURN 2$: ERROR M 3$: RETURN .SBTTL OP CODE PROCESSOR PROPC: ;PROCESS OP CODE SWAB R1 ASL R1 BIC #177400,R1 ;ISOLATE TYPE CLR MODE ;FORCE ABSOLUTE APPEND CODROL ;STUFF BASIC VALUE CLR OFFSET CLR R0 ;FUNCTION REGISTER JSR PC,@PROPCT(R1) ;CALL ADDRESS HANDLER MOV ROLBAS+CODROL,R1 BIS R0,6(R1) ;SET EXPRESSION BITS � 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+12. ;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 FUNCTO: BIS #100000,R0 ;SET THE SIGN BIT MOV R0,PARCN�NLY CODE TO COPY IN THE VERSION NUMBER ; EXACTLY EIGHT BYTES ARE USED ; MOV #VERSON,R0 MOV #VER1,R1 MOV #VER2,R2 MOV #8.,R3 VERLOP: MOVB @R0,(R1)+ MOVB (R0)+,(R2)+ DEC R3 BGT VERLOP JMP RSET NODGN: CLR DPTR ;SET NON-EXISTENT CLR DPTR+2 ;OR BAD FILE BR EXIT ; ;OVERLAY FILE IS FORTRN.OVL 0 ;ERROR RETURN 4 ;OPEN FOR INPUT FB0: .RAD50 /FOR/ .RAD50 /TRN/ .RAD50 /OVR/ 401 ;1,1 0 ;PTC BLKSIZ: 0 BLKCNT: .BLKW ; ;FILE BLOCK ; .WORD NODGN .BYTE 1 .BYTE 0 DI�ER06: ;ADB WAS ATTACHED TO SYMBOL TABLE ENTRY ;ON NORMAL EXIT FROM QADBOK (V=0) KER09: TST T3(SP) ;IS THIS A "TYPE" STATEMENT? BNE KER50 ;BR IF NOT, DIMENSION STATEMENT KER092: BIC #DATYMM,DATYWD(R3) ;PUT TYPE INTO SYM TBL ENTRY MOV T4(SP),R4 CCC SWAB R4 ASL R4 ASL R4 ASL R4 BIC #DATYMK,R4 BIS R4,DATYWD(R3) BIS #EXPMKM,EXPWD(R3) ;SET "EXPLICITLY TYPED" BIT KER11: JSR PC,CNXC ;GET NEXT NON-BLANK CHARACTER .GLOBL CNXC BEQ KER15 ;ZERO, END OF LINE CMPB (R1),#', ;LOOK FOR LE�RETURN PROPCT: .WORD PRCL00 .WORD PRCL01 .WORD PRCL02 .WORD REGEXP ;PRCL03 .WORD PRCL04 .WORD PRCL05 .WORD PRCL06 PROPCL= .-PROPCT PRCL00: RETURN PRCL01: CALL AEXP RETURN PRCL02: CALL AEXP PRCL2A: SWAB R0 ;SHIFT LEFT SIX ROR R0 ROR R0 MOV R0,-(SP) TSTCOM CALL AEXP BIS (SP)+,R0 RETURN PRCL04: RELEXP CMPB SECTOR,CLCSEC BNE 2$ SUB CLCLOC,R0 ASR R0 BCS 2$ DEC R0 BIT #000200,R0 BEQ 1$ ADD #000400,R0 1$: BIT #177400,R0 BEQ 3$ 2$: ERROR A MOV �T ;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+55. RTS PC BADPAR: TRAP+56. BADP1: JSR PC,NXTCH CMPB R2,#', BEQ SUBLP CMPB R2,#') BNE BADP1 RTS PC .END �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������FILE: .RAD50 /FOR/ .RAD50 /COM/ .RAD50 /DGN/ .WORD 401 ;USER 1,1 .WORD 0 ; ; WE HAVE REACHED THE END OF THE SUPER-SET-UP STUFF. ; ISN'T IT ISOMETRIC?!!? ; .END FORTRN ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������GAL COMMA BEQ KER13 ;FOUND IT TRAP+135. ;NO COMMA KER13: JSR PC,CNXC1 ;GET NEXT NON-BLANK CH. TSTB (R1) ;IS IT A ZERO? BEQ KER15A ;YES CMPB (R1),#', ;HOW ABOUT A COMMA? BNE 1$ ;NO, GO AWAY HAPPY TRAP+136. ;TOO MANY COMMAS BR KER13 ;KEEP LOOPING 1$: MOV T11(SP),R2 ;BRING BACK PTR TO ADB AREA BR KER01 KER50: TST R2 ;TEST FOR DIMENSIONING AGAIN BNE KER11 ;BR IF DIM'D. ELSE ERROR-- TRAP+19. ;DIAG:"DIMENSION STATEMENT LIST ITEM LACKS ;DIMENSIONING ELEMENTS" BR KER11 KER15A�#000377,R0 3$: RETURN PRCL05: REGEXP BR PRCL2A PRCL06: ;TRAP TYPE MOV VALUE,-(SP) ;SAVE THE VALUE EXPR ;EVALUATE THE EXPRESSION (NULL OK) SETIMB ;TREAT AS BYTE CMPB SECTOR,#200 ;ABSOLUTE? BNE 1$ ; NO TST (SP)+ ;YES, PRUNE STACK MOV VALUE,R0 ;VALUE TO MERGE RETURN 1$: ZAP CODROL ;CLEAR CODE ROLL STCODE ;STORE ADDRESS MOV #100000,MODE ;SET FOR ABSOLUTE BYTE SWAB (SP) MOV (SP)+,VALUE ;SET ORIGIONAL VALUE STCODE CLR R0 RETURN AEXP: ;ADDRESS EXPRESSIO�����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������: TRAP+17. ;BAD-BAD KER15: MOV (SP),R4 ;NORMAL EXIT-TYPE,DIM MOV T2(SP),R5 ADD #T15,SP ;RELEASE TEMPORARIES CLV RTS PC KER08: TRAP+20. ;DIAG:"CONFLICTING DIMENSIONING ;SPECIFIED IN AN EARLIER STATEMENT" BR KER09 ; ; ; ; ; ; ;QADBOK ; ;INPUT (R2)=ADB BASE FOR ADB JUST CREATED ; (R3)=ADDR OF SYMB TABLE ENTRY ; ;OUTPUTS AND FUNCTIONS ; IF SYMBOL ENTRY NOT DIMENSIONED, THE ADB IS ; ATTACHED (NORMAL EXIT). ; ELSE THE NEW & OLD ADB'S ARE COMPARED: ; IF EQUAL, NORMAL EXIT ; EL�N EVALUATION INC EXPFLG CLR -(SP) ;ACCUMULATE ON TOP OF STACK 2$: CMP R5,#CH.IND ;INDIRECT (@)? BNE 6$ ; NO BIT #10,(SP) ;YES, SECOND TIME AROUND? BEQ 4$ ; NO ERROR Q ; YES 4$: BIS #10,(SP) ;SET IT GETNB ;MOVE PAST BR 2$ 6$: CMP R5,#CH.HSH ;LITERAL (#)? BNE 10$ ; NO GETNB ;YES, MOVE PAST GLBEXP ;EVALUATE EXPRESSION BIS #27,(SP) ;SET BITS BR AEXP32 ;USE COMMON EXIT 10$: CMP R5,#CH.SUB ;PERHAPS AUTO-DECREMENT (-)? BNE 12$ ; NO MOV CHRPNT,SYMBEG ;PERHAP� .TITLE UTILTY .IDENT /0612/ ;RFB,LP ;COPYRIGHT 1971, 1973, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754 ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ;WRITTEN BY RON BRENDER, DAVE KNIGHT, LOU COHEN .GLOBL OTOA,CKOP,SCAN2A,GENLAB,OUTLN2 .GLOBL OUTCH2,INHLAB,LINENO,SEQNO,HDR,HEAD,HLGT,BLKDAT .GLOBL NXTCH,FILL,CHTEST,GETID,PACK00 .GLOBL CNXC,CNXC1,CHT1 .GLOBL CURSYM,ENTYMM,ENTYWD,EOL,GET,OUTCHR .GLOBL OUTLN,OUT� .TITLE SYMTAB .IDENT /0708/ ; ;COPYRIGHT 1971, 1972, DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT, L. COHEN ; ;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,LOGREL,OLDLOW,STKBAS,SCANNR .GLOBL PUTSYM,GETSYM,MOVE,FRHIGH .GLOBL�SE ERROR EXIT. ; V=0 NORMAL EXIT ; V=1 ERROR EXIT ; ALL REGISTERS PRESERVED ; QADBOK: MOV R0,-(SP) MOV R2,-(SP) ; MOV R3,-(SP) MOV ADBPWD(R3),R0 BNE QADB01 ;0 => CAN USE THIS ADB ;OKAY - ITS GOOD JSR PC,UADBOK ;ATTACH THIS ADB QADB05: MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R0 CLV RTS PC ; QADB01: ADD SYMBAS,R0 ;GET REAL ADDRESS CMP (R0)+,(R2)+ ;STEP OVER 1ST WORD IN EACH ADB CMP (R0),(R2)+ ;COMPARE 2ND WORDS BNE QADB02 ;DIFFERENT => NO GOOD MOV (R0)+,R3 ;GET 2ND WORD, C�S, SAVE JUST IN CASE GETNB CMP R5,#CH.LP ;YES? BNE AEXP20 ; NOT A CHANCE CALL AEXPLP ;PROCESS PARENS BIS #40,(SP) BR AEXP36 12$: CMP R5,#CH.LP ; "("? BNE AEXP22 CALL AEXPLP ;EVALUATE REGISTER CMP R5,#CH.ADD ;AUTO-INCREMENT (+)? BNE 14$ ; NO GETNB ;YES, POLISH IT OFF BIS #20,(SP) ;SET BITS BR AEXP36 14$: BIT #10,(SP) ;INDIRECT SEEN? BNE 16$ ; YES BIS #10,(SP) ;NO, SET BIT BR AEXP36 16$: CLR MODE CLR VALUE BR AEXP30 AEXP20: SETSYM ;AUTO-DEC FAILURE,�LN1,PUTA,PUTWK,SYMBAS,SYM1WD .CSECT R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 SPACE=40 ; ; ; ;CHTEST TESTS IF THE BYTE POINTED TO BY R1 IS A LETTER, ; NUMBER, OR OTHER. ;CHT1: DOES THE SAME THING, ON THE CONT. OF R2 ; NOTE: THE CHTEST ENTRY CLOBBERS R2. ; CALL- JSR PC,CHTEST ; INPUT- BYTE IS POINTED TO BY R1 ; OUTPUT- IS IN THE CONDITION CODES ; N=1 DIGIT ; V=1 LETTER ; C=1 NEITHER DIGIT NOR LETTER ; ONLY 1 CODE WILL BE ON AT ANY RETURN. THUS, C=0 IMPLIES ;� GETID,CHTEST,FILL,IMPTAB,PACK00 .GLOBL CURSYM,GETSW,NXTCH,SYMCUR,CONINT .GLOBL OTOA,SYMEND,SYMCUR,SYMNXT,CNXC1 .GLOBL ENTYWD,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,ADBPWD,VALUE,SYMBYT,SYMSIZ .GLO�ONTAINS # DIM'S ROL R3 ROL R3 ROL R3 BIC #177774,R3 ;ISOLATE # DIM'S QADB04: CMP (R0)+,(R2)+ BNE QADB02 DEC R3 BNE QADB04 BR QADB05 ; QADB02: MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R0 SEV RTS PC ���������������������������������������� ; ; ;UADBOK: ATTACHES ADB TO SYMBOL TABLE ENTRY ; (R2)=START OF ADB ; (R3)=SYMBOL TABLE START ; UADBOK: SUB #T5,SP ;RESERVE TEMPS MOV R4,(SP) MOV R5,T2(SP) UADB02: MOV SYMNXT,R4 ;ATTACH ADB TO ENTRY MOV R4,ADBPWD(R3) ;PUT ADB POINTE� POINT TO - AEXP22: GLBEXP ;GET AN EXPRESSION CMP R5,#CH.LP ;INDEXED? BEQ 24$ ; YES BIT #REGFLG,FLAGS BNE AEXP36 BIS #67,(SP) ;NO SETDSP ;SET DISPLACEMENT BR AEXP34 24$: BIT #REGFLG,FLAGS BEQ 26$ ERROR R BIC #REGFLG,FLAGS 26$: MOV #SYMBOL,R1 MOV (R1)+,-(SP) ;STACK CURRENT VALUE MOV (R1)+,-(SP) MOV (R1)+,-(SP) MOV (R1)+,-(SP) MOV R1,-(SP) CALL AEXPLP ;PROCESS INDEX MOV (SP)+,R1 MOV (SP)+,-(R1) ;RESTORE MOV (SP)+,-(R1) MOV (SP)+,-(R1) MOV (SP)+,-(R1) AE� EITHER N=1 OR V=1 ; CHTEST: MOVB (R1),R2 CHT1: CMPB R2,#'0 BLO CHT01 ;BR IF LESS THAN ALL DIGITS CMPB R2,#'9 BHI CHT02 ;BR IF GTR THAN ALL DIGITS CCC ;RETURN DIGIT SEN RTS PC CHT01: CCC ;RETURN NEITHER SEC RTS PC CHT02: CMPB R2,#'A BLO CHT01 ;BR IF LESS THAN ALL LETTERS CMPB R2,#'Z BHI CHT01 ;BR IF GTR THAN ALL LETTERS CCC ;RETURN LETTER SEV RTS PC ���������������������������������������� ; ; ;FILL-- JSR PC,FILL ;INPUTS R3 CONTAINS WORD TO BE FILLED INTO MEM�BL 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,T26,T27,T28,T29,T30 .GLOBL $RCI,$DCI,NAMSER,SYMSER .GLOBL PSHWD,PSHMKM,PSHMK ;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 ;GLOBAL SYMBOLS FOR SYMBOL TABLE ENTRY FORMATS, ETC. ; ARE DEFINED SEPARATELY IN THE MODULE SYMBOL.MAC ; WHICH MUST ALWAYS BE LIN�R INTO ENTRY SUB SYMBAS,ADBPWD(R3) ;MAKE REL. TO STRT OF TBL TST ADBCUR ;IS THIS THE 1ST ADB? BEQ UADB04 ;BR IF YES, ELSE-- MOV ADBPWD(R3),@ADBCUR ;PUT POINTER INTO LAST ;ADB ENTERED. UADB04: MOV R4,ADBCUR ;UPDATE CURRENT ADB POINTER MOV 2(R2),R5 ;DETERMINE SIZE OF ADB ROL R5 ROL R5 ROL R5 BIC #177774,R5 ;# OF DIMENSIONS MOV R5,T4(SP) ;SAVE # DIM'S ADD #2,R5 ;ADD CONSTANT AMOUNT FOR ADB HDR ASL R5 ;TIMES 2 FOR NO. OF WORDS ADD R5,SYMNXT ;UPDATE POINTER TO FREE ;SYMBOL TAB�XP30: BIS R0,(SP) BIS #60,(SP) AEXP32: SETIMM AEXP34: STCODE INC OFFSET CLR R0 AEXP36: BIS (SP)+,R0 RETURN .CSECT IMPURE OFFSET: .BLKW 1 .CSECT AEXPLP: ;AEXP PAREN PROCESSOR GETNB ;BYPASS PAREN REGEXP ;GET A REGISTER EXPRESSION CMP R5,#CH.RP ;HAPPY ENDING ")"? BEQ 1$ ; YES ERROR Q ;NO RETURN 1$: GETNB RETURN .SBTTL EXPRESSION TO CODE-ROLL CONVERSIONS SETIMB: ;SET IMMEDIATE, BYTE MODE SETIMM ;SET IMMEDIATE TSTB VALUE+1 ;ANY HIGH ORDER BITES?�ORY ; R4 CONTAINS STARTING ADDR OF FILL AREA ; R5 CONTAINS LAST LOC. TO BE FILLED. ; FILL: CMP R4,R5 ;DONE? BHI FILL01 ;BR IF YES MOV R3,(R4)+ ;ELSE FILL A WORD BR FILL FILL01: RTS PC ; ; SERVICE ROUTINES FOR HANDLING FLOW AROUND ; DATA AREAS ; .GLOBL GNTR$S,BITM,MISC,SLABL,FLABL GNTR$S: BITB BITM+2,MISC+6 ;IS TRANSFER ALREADY GENERATED? BNE 1$ ;BR IF YES JSR R5,OUTLN2 +GNTR$A ;$TR, MOV FLABL,R3 ;LABEL NUMBER INC FLABL MOV R3,SLABL ;REMEMBER FOR LATTER MOV #'S,R0 �KED WITH SYMTAB ; ;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 15 BITS; V=0 OTHERWISE CONINT: CLR R3 ;INITIALIZE RESULT ACCUMULATOR CON02:�LE SPACE CMP SYMNXT,SYMEND ;WILL ADB FIT IN TABLE? BLO UADB06 ;SKIP IF IT WILL FIT JSR PC,GETMEM ;TRY TO GET MORE STORAGE BVC UADB06 ;GOT IT TRAP+5. ;SYMBOL TABLE FULL MOV STKBAS,SP ;PUNT JMP SCANNR ;AND GO AWAY UADB06: MOV R3,T3(SP) ;SAVE R3,SET R3=SOURCE OF MOVE MOV R2,R3 ;R4 ALREADY INITIALIZED JSR PC,MOVE MOV T3(SP),R3 ;RESTORE R3 ;PUT DIM INTO ENTRY. MOV T4(SP),R5 ;RECALL # DIM'S SWAB R5 ASL R5 BIC #DIMMK,R5 ;ISOLATES FIELD TO BE INSERTED BIC #DIMMKM,DIMWD(R3) ;ZER� BNE 1$ ; YES, ERROR CMPB SECTOR,#RLDT01 ;ERROR IF RLD TYPE 1 BEQ 1$ CMPB SECTOR,#RLDT15 ; OR 15 BNE 2$ 1$: ERROR A ;FLAG ERROR CLRB SECTOR CLRB VALUE+1 2$: BISB #200,SECTOR ;FLAG AS BYTE RETURN SETIMM: ;SET IMMEDIATE MODE MOV R1,-(SP) MOV #IMMMOD,R1 ;SET TABLE INDEX TST ENDFLG ;SPECIAL FOR .END? BNE SETDS1 ; YES BITB #GLBFLG,FLAGS ;EXTERNAL? BNE SETDS3 ; YES, USE COMMON HANDLER TST (R1)+ ;MOVE INDEX BITB #RELFLG,FLAGS ;RELOCATABLE? BEQ SETDSX ; NO, � JSR PC,OUTSER JSR PC,EOL BISB BITM+2,MISC+6 ;FLAG TRANSFER GENERATED BISB BITM+4,MISC+0 ;FLAG $TR GLOBL DONE 1$: RTS PC ; ; HERE TO DEFINE $S LABEL ; .GLOBL GNTL$S GNTL$S: MOV #'S,R0 MOV SLABL,R3 JSR PC,OUTSER JSR R5,OUTLN2 +GNTL$A ;=. RTS PC ; ; HERE TO FLAG NEW TRANSFER START NEEDED ; .GLOBL GNTR$X GNTR$X: BICB BITM+2,MISC+6 RTS PC ; GNTR$A: .ASCII / .GLOBL $TR/<15><12> .ASCIZ / $TR,/ GNTL$A: .ASCIZ / =./<15><12> .EVEN ���������������������������������������� JSR PC,CHTEST ;CHECK CURRENT CHARACTER TYPE. BMI CON035 ;BR IF A DIGIT (N=1) CON013: 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 ;CHECK OVERFLOW AGAIN BMI CON01 ADD R5,R3 ;((R3)*8)+(R3) BVS CON01 ;CHECK OVERFLOW ADD R5,R3 ;((R3)*9)+(R3�OS OUT RESULT FIELD BIS R5,DIMWD(R3) ;ADB NOW PROPERLY ATTACHED TO SYMBOL TABLE ENTRY. ;DO A NORMAL RETURN. UADB03: MOV T2(SP),R5 ;RESTORE R5,R4 MOV (SP),R4 ADD #T5,SP ;RELEASE TEMPS CLV ;V=0 RTS PC ; .END ; ; �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ALL SET TSTB (R1)+ CMPB SECTOR,CLCSEC ;YES, CURRENT SECTOR? BEQ SETDSX ; YES BR SETDS1 ;NO SETDSP: ;SET DISPLACEMENT MODE MOV R1,-(SP) MOV #DSPMOD,R1 ;SET INDEX BITB #GLBFLG,FLAGS ;EXTERNAL? BNE SETDS3 ; YES, TEST FOR ADDITIVE TST (R1)+ CMPB SECTOR,CLCSEC ;CURRENT SECTOR? BEQ SETDS2 ; YES TSTB (R1)+ TSTB SECTOR ;LOOKING AT ABSOLUTE? BEQ SETDSX ; YES SETDS1: TSTB (R1)+ MOVB SECTOR,R0 ;FETCH SECTOR BIC #177400,R0 ;CLEAR HIGH BITS MOV R0,-(SP) ;SAVE A COPY �� ����������������������������������������; ; OUTCOL - OUTPUT A COLON ; .GLOBL OUTCOL OUTCOL: MOVB #':,R4 BR OUT ; ; OUTCOM - OUTPUT A COMMA ; .GLOBL OUTCOM OUTCOM: MOVB #',,R4 BR OUT ; ; OUTTAB - OUTPUT A TAB ; .GLOBL OUTTAB TAB = 11 OUTTAB: MOVB #TAB,R4 OUT: JSR PC,OUTCHR RTS PC .GLOBL PUTNM1,PUTNAM,PUTCHR,OUTNAM,OUTGL ; ;PUTNAM - PUT NAME IN TEMPORARY PREPARATORY TO OUTPUT. ; PUTNM1: MOV #PUTA,PUTWK ;RESET THE POINTER PUTNAM: MOV R5,-(SP) ;SAVE R5 MOV PUTWK,R5 ;GET ADD�)=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 BVS CON013 BR CON02 ; ;LITTLE SUBROUTINE TO CHECK FOR AVAILABLE SPACE IN BUILD AREA ; CON03: CMP R4,SYMEND ;CHECH THAT R4 IS NOT BEYOND BLO CON031 ;SYMBOL TABLE.--BR IF OK JSR PC,GETMEM ;GET MORE TABLE SPACE BVC CON03 ;OK IF NO OVERFLOW TRAP+14. ;ELSE, ISSUE DIAGNOSTIC. CLR R3 SEV RTS PC CON031: CLV RTS ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ASL R0 ;MULTIPLY BY FIVE ASL R0 ADD (SP)+,R0 ASL R0 ;TWO BYTES TO WORD ADD ROLBAS+SECROL,R0 ;COMPUTE BASE OF SECTOR ROLL MOV (R0)+,SYMBOL ;XFER SECTOR NAME TO SYMBOL MOV (R0)+,SYMBOL+2 BR SETDSX SETDS2: MOV OFFSET,-(SP) ;GET OFFSET (0 OR 1) ASL (SP) ADD #4,(SP) ;PC WAS GETTING AHEAD OF US ADD CLCLOC,(SP) SUB (SP)+,VALUE CLR MODE BR SETDSX SETDS3: TST VALUE ;EXTERNAL, ANY OFFSET? BEQ SETDSX ; NO TSTB (R1)+ ;YES, ADVANCE INDEX SETDSX: MOVB (R1),SECTOR ;FILL IN TYP�RESS OF WORKAREA PUT001: MOVB (R4)+,(R5)+ ;STORE A CHARACTER BNE PUT001 ;LOOP UNTIL DONE DEC R5 ;BACK UP OVER NULL MOV R5,PUTWK ;REMEMBER POINTER POSITION MOV (SP)+,R5 ;RESTORE R5 RTS PC ; ; PUTCHR- PUT A CHARACTER IN THE NAME TEMPORARY ; PUTCHR: MOV R5,-(SP) ;GET MOV PUTWK,R5 ;THE POSITION POINTER MOVB R4,(R5)+ ;STORE THE CHARACTER CLRB @R5 ;SET THE TERMINATOR MOV R5,PUTWK ;REMEMBER POSITION MOV (SP)+,R5 ;RESTORE R5 RTS PC ;AND RETURN ; ; OUTNAM - OUTPUT THE STUFF INT EH �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 CON012: MOV #077777,R3 ;SUBSTITUTE LARGEST POS VAL SEV ;SET V=1 RTS PC CON011: JSR PC,CON03 ;CHECK IF NEXT BYTE FITS BVS CON012 MOVB (R1),(R4)+ BR CON01 ; ; ����������������������������������������; ; ;CONCOM COMPARES VALUE IN SYM.TBL. ENTRY (VIA R3) WITH ;THE CONSTANT POINTED � .TITLE SYMBOL .IDENT /7.01/ ; ;COPYRIGHT 1971,972 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; WRITTEN BY D. KNIGHT ; ;FORTRAN SYMBOL TABLE HANDLING ROUTINES .GLOBL NAMMK,NAMMKM,NAMWD .GLOBL COMNWD,ALLOWD,ALLMK,ALLMKM .GLOBL ENTYWD,ENTYMM,ENTYMK,DATYWD,DATYMK,DATYMM .GLOBL DIMWD,DIMMK,DIMMKM,CONWD,CONMK,CONMKM .GLOBL LENWD,LENMK,LENMKM,PARXWD,PARXMK,PARXMM .GLOBL COMWD,COMMKM,COMMK,A�E MOV (SP)+,R1 RETURN IMMMOD: .BYTE RLDT02, RLDT05, RLDT00, RLDT01, RLDT15, 0 .EVEN DSPMOD: .BYTE RLDT04, RLDT06, RLDT00, RLDT03, RLDT16, 0 .EVEN .SBTTL CODE ROLL STORAGE STCODE: APPEND CODROL ;APPEND TO CODROL RETURN .SBTTL DIRECTIVES .GLOBL GLOBL GLOBL: ;GLOBAL HANDLER GETSYM ;GET A SYMBOL BEQ 2$ ; ERROR IF NULL CMP R0,R50DOT ;DOT? BEQ 2$ ; YES, ERROR SSRCH ;NO, SEARCH USER SYMBOL TABLE BIT #REGFLG,FLAGS ;REGISTER? BNE 3$ ; YES, ERROR BIS #GLBF�NAME TEMPORARY ; OUTNAM: MOV #PUTA,R4 ;GET THE POINTER MOV R4,PUTWK ;RESET THE POINTER JSR PC,OUTLN1 ;OUTPUT THE NAME RTS PC ;RETURN ; ; OUTGL - OUTPUT A GLOBAL FROM THE NAME TEMPORARY ; OUTGL: JSR R5,OUTLN2 ;GENERATE THE GLOBAL WORD OUTG BR OUTNAM ;NOW THE NAME OUTG: .ASCII / .GLOBL/ .BYTE 0 ; ; ; CKOP - CHECK THE NEXT ONE TO FIVE CHARACTERS UNDER ; SCAN (AS REQUIRED) TO DETERMINE IF THEY COMPRISE ; A LEGAL OPERATOR. IF NOT RECOGNIZED, THE POINTER ; IS NOT ADVANCED AND OVERFLO�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 ;ELSE ARE MODES OF ENTRY AND CONSTANT EQUAL? MOV DATYWD(R3),-(SP) ;THIS RIGAMAROLE BIC #DATYMK,(SP) ;IS TO ISOLATE THE DESIRED BIC #DATYMK,R�DJWD,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,ADBPWD,VALUE,SYMBYT,SYMSIZ .GLOBL XPRWD,XPRMK,XPRMKM .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,T26,T27,T28,T29,T30 .GLOBL PSHWD,PSHMKM,PSHMK ;TEMPORARIES ARE INDEXED OFF THE STACK ; T1=0 T2=2 T3=4 T4=6 T5=10 T6=12 T7=14 T8=16 T9�LG,FLAGS ;NO, FLAG AS GLOBL INSERT ;UPDATE/INSERT 1$: TSTCOM ;ANY MORE? BNE GLOBL ; YES RETURN ; NO, EXIT 2$: ERROR A BR 1$ 3$: ERROR R BR 1$ .GLOBL $END $END: ;TEMP END DIRECTIVE EXPR ;EVALUATE THE EXPRESSION BNE 1$ ; BRANCH IF NON-NULL INC VALUE ;NULL, MAKE IT A ONE 1$: CALL RELTST ;NO GLOBALS ALLOWED INC ENDFLG SETIMM ;FILL OUT BLOCK SETPF1 ;LIST FIELD 1 APPEND ENDROL ;PLACE ON ROLL RETURN .GLOBL CSECT .IF NDF XFTN .GLOBL ASECT �W IS RETURNED. ; IF RECOGNIZED, R1 IS ADVANCED PAST THE OPERATOR, ; THE LOW BYTE OF R0 RETURNS THE PRIORITY AND THE ; HIGH BYTE RETURNS THE OPERATOR IDENTIFIER AS FOLLOWS: ; ; ID PRIORITY OPERATOR ; 1 0 .OR. ; 2 1 .AND. ; 3 2 .NOT. ; 4 4 + ; 5 4 - ; 6 5 * ; 7 5 / ; 10 6 ** ; 11 7 UNARY - ; 12 3 .LT. ; 13 3 .GT ; 14 3 .EQ. ; 15 3 .NE. ; 16 3 .LE. ; 17 3 .GE. ; ; THE UNARY MINUS IS NOT RECOGNIZED BY THIS ROUTINE ; BECAUSE IT IS CONTEXT SENSITIVE. IT �5 ;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 ;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 �=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 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 � ASECT: CALL SETMAX ;CLEAN UP CURRENT SECTOR MOV R50ABS,SYMBOL ;SET ". ABS." MOV R50ABS+2,SYMBOL+2 BR CSECTF ;USE COMMON EXIT .ENDC CSECT: CALL SETMAX ;CLEAN UP CURRENT SECTOR GETSYM ;GET ARGUMENT (OR NULL) CSECTF: SCAN SECROL ;SCAN FOR MATCH BNE 3$ ; BRANCH IF MATCH MOVB SECTMP,SECTOR ;NEW GUY, SET SECTOR BEQ 2$ ;BRANCH IF ABS SECTOR (FOR NOW) BIS #RELFLG,MODE 2$: INSERT ;ATTACH TO ROLL 3$: SETPF1 MOV #SYMBOL,R1 MOV #CLCNAM,R2 JMP XMIT5 ;MOVE AND EXIT .C�HAS AN ID OF 11 ; AND A PRIORITY OF 6. ; ; REGISTERS CHANGED - R0,R1,R2,R3; CKOP: MOV #CKPLST,R0 ;GET ADDRESS OF OPERAND TABLE JSR PC,SCAN2A ;GO FIND AN OPERATOR BVS CKOP01 ;NO SUCH LUCK MOV CKPVAL(R0),R0 ;GET OPERATOR AND PRIORITY CKOP01: RTS PC ;AND RETURN .GLOBL LOGREL ; ; OPERATOR PROTOTYPE TABLE ; CKPLST: CK0 CK1 CK2 CK3 CK4 LOGREL: CK5 CK6 CK7 CK8 CK9 CK10 CK11 CK12 CK13 CK14 0 ; CK0: .BYTE '+ CK1: .BYTE '- CK2: .BYTE '*,'* CK3: .BYTE '* CK4: .BY� ;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 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 W�(COMPL) DIMMKM=003000 CONWD=0 ;CONSTANT INDICATOR WORD (*2) CONMK=177377 ;CONSTANT INDICATOR 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 ;�SECT IMPURE SECTMP: .BLKW .CSECT SETMAX: ;SET MAX AND ENTER ONTO ROLL SAVREG ;PLAY IT SAFE CMP CLCLOC,CLCMAX ;NEW HIGH? BLOS 1$ ; NO MOV CLCLOC,CLCMAX ;YES, SET IT 1$: MOV #CLCNAM,R1 MOV #SYMBOL,R2 CALL XMIT2 ;MOVE NAME TO SYMBOL SCAN SECROL ;SCAN SECTOR ROLL CALL XMIT3 ;SET REMAINDER OF ENTRIES INSERT ;UPDATE ROLL RETURN .GLOBL TITLE .IF NDF XFTN .GLOBL SBTTL .ENDC TITLE: GETSYM ;GET A SYMBOL BEQ 1$ ; ERROR IF NULL MOV SYMBOL,PRGTTL ;MOVE INT�TE '/ CK5: .ASCII /.OR./ CK6: .ASCII /.AND./ CK7: .ASCII /.NOT./ CK8: .ASCII /.LT./ CK9: .ASCII /.GT./ CK10: .ASCII /.EQ./ CK11: .ASCII /.NE./ CK12: .ASCII /.LE./ CK13: .ASCII /.GE./ CK14 = . .EVEN ; ; FOLLOWING TABLE CONTAINS THE OPERATOR PRIORITY ; FOLLOWED BY ITS INTERNAL NAME IN ORDERED PAIRS. ; .GLOBL PLUS,MINUS,PWR,MUL,DIV,OR,AND,NOT .GLOBL LT,GT,EQ,NE,LE,GE CKPVAL:PLUS: .BYTE 4,4 MINUS: .BYTE 4,5 PWR: .BYTE 6,10 MUL: .BYTE 5,6 DIV: .BYTE 5,7 OR: .BYTE 0,1 AND: .BYTE 1,2 �ANT 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" 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 BEE�ADJUSTABLE ARRAY IND WORD (*2) ADJMKM=002000 ADJMK=175777 ;ADJUSTABLE ARRAY 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. SO STORAGE MOV SYMBOL+2,PRGTTL+2 .IF NDF XFTN MOV #TTLASC,R2 R50UNP MOVB #TAB,-(R2) .ENDC BR 2$ 1$: ERROR A 2$: .IF NDF XFTN SBTTL: CLR R5 RETURN .ENDC .CSECT IMPURE PRGTTL: .BLKW 4 .CSECT .GLOBL EVEN .IF NDF XFTN .GLOBL BLKW,BLKB,ODD,RADIX,EOT BLKW: INC R3 ;FLAG WORD TYPE BLKB: EXPR ;EVALUATE THE EXPRESSION BNE 1$ ;BRANCH IF NON-NULL INC VALUE ;NULL, MAKE IT ONE 1$: CALL ABSTST ;MUST BE ABSOLUTE TST R3 ;WORD? BEQ 2$ ; NO ASL R0 ;YES, DOUBLENOT: .BYTE 2,3 LT: .BYTE 3,12 GT: .BYTE 3,13 EQ: .BYTE 3,14 NE: .BYTE 3,15 LE: .BYTE 3,16 GE: .BYTE 3,17 ����������������������������������������; ; ; ; CALL JSR PC,GETID ;GETID (R1)=INPUT, POST INCREMENTED AFTER EACH MOVE ; (R5)=OUTPUT, POINTING TO THE TERM. 0-BYTE ON RETURN. ; R4 CLOBBERED ; GETS UP TO 6 CH, STOPS ON A NON-DIGIT/NON-LETTER ; APPENDS A 0 BYTE TO THE OUTPUT STRING GETID: MOV #6,R4 JSR PC,CHTEST ;IS 1ST CH A LETTER BVC GETI03 ;BR IF NOT GETI02: MOVB @R1,(R5)+ ;MOVEN 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,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,RGLMK=077777 SGLMKM=100000 PSHWD=12 ;PUSH FLAG POINTER PSHMKM=004000 PSHMK=173777 ASGWD=12 ;ASSIGNED GO TO INDICATOR 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. TABL IT 2$: ADD R0,(R4) ;UPDATE THE PC RETURN .ENDC EVEN: INC (R4) ;INCREMENT THE PC BIC #1,(R4) ;CLEAR IF NO CARRY RETURN .IF NDF XFTN ODD: BIS #1,(R4) ;SET LOW ORDER PC BYTE RETURN RADIX: MOV CRADIX,-(SP) MOV #10.,CRADIX ABSEXP CMP R0,#2. BLT 1$ CMP R0,#10. BLE 2$ 1$: ERROR A MOV (SP),R0 2$: MOV R0,CRADIX TST (SP)+ SETPF1 RETURN EOT: RETURN .ENDC .SBTTL DATA-GENERATING DIRECTIVES .GLOBL BYTE,WORD .IF NDF XFTN .GLOBL LIMIT .ENDC BYTE: TS CH TO OUTPUT JSR PC,CNXC1 ;GET NXT CH JSR PC,CHTEST ;IS IT A DELIMITER? BCS GETI01 ;BR IF YES DEC R4 ;REDUCE LOOP COUNT BNE GETI02 ;BR IF NO, ELSE FALL THROUGH. GETI01: CLRB (R5) ;DROP A 0 INTO OUTPUT CLV RTS PC GETI03: SEV RTS PC ���������������������������������������� ; ; MOD40 PACK - ENTERED WITH JSR PC, PACK00 ; ; INPUT: R0=ADR OF MOD40 WORDS (2 WORDS) ; R1=ADR OF ASCII CHARACTERS (6 CHARS) ; ; OUTPUT: R1 POINTS ONE PAST END OF ASCII STRINT ; THE MOD40 WORD IS FORM5 ;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 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 CMPB (R1),#'" ;IS THIS AN OCTAL CONSTANT? BEQ GET600 CMPB (R1),#'. BEQ GET40A CMPB (R1),#'' BEQ GET50A ; ;EXIT - NEITHER LETTER NOR DIGIT ; GET09: MOV T16(SP),R4 MOV T17(SPE ENTRY (FXD PART) SYMSIZ=10 ;NO. WORDS IN SYM. TABLE ENTRY (FXD PART) ���������������������������������������� .IFDF COM8K R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 ; ;MOVE ROUTINE. #WORDS IN R5, SOURCE BLOCK ;IN R3, DESTINATION BLOCK IN R4. WILL POINT TO NEXT ;AVAILABLE WORD ON EXIT ; ; .GLOBL MOVE MOVE: TST R5 ;0 WORDS? BEQ MOVE01 ;DONE MOV (R3)+,(R4)+ ;ELSE MOVE 1 WORD DEC R5 BR MOVE MOVE01: RTS PC .ENDC .END ����������������������������������� T (R3)+ ;MAKE R3=2 FOR BYTE WORD: 1$: GLBEXP ;EVALUATE EXPRESSION CALL @BYTWRD(R3) ;SELECT PROPER CONVERSION STCODE ADD BYTWRD+4(R3),(R4) ;INCREMENT PC TSTCOM BNE 1$ RETURN BYTWRD: .WORD SETIMM, SETIMB ;CODE ROLL CONVERSION .WORD 2, 1 ;PC INCREMENT .IF NDF XFTN LIMIT: CALL OBJDMP MOV #RLDT11*400,MODE ;SET RLD TYPE CLR VALUE STCODE CLR MODE STCODE RETURN .ENDC .GLOBL ASCII .IF NDF XFTN .GLOBL RAD50,ASCIZ RAD50: 1$: CALL RAD50C ;GET A CHARACTER BLT ASCI ED AS ; N=C1*40^2+C2*40+C3 ; ; R2,R3,R4,R5 ARE CLOBBERED PACK00: CLR -(SP) ;CLEAR TERMINATOR SWITCH MOV #-2,R5 ;MAJOR LOOP COUNT PACK01: MOV #-3,R4 ;MINOR LOOP CT. CLR R2 ;0 SUM PACK05: TST @SP ;TEST TERMINATED SWITCH BNE PACK10 MOVB (R1)+,R3 ;GET NEXT ASCII CHAR. PACK06: CMPB #' ,R3 BEQ PACK02 ;"BLANK" CMPB #'$,R3 BEQ PACK04 ;"$" CMPB R3,#'A BLO PACK09 ;"." OR "0-9" SUB #40,R3 ;"A"-"Z" BEQ PACK08 CMP R3,#'Z-'A+41 BGT PACK08 ;NON-RAD50 CHAR PACK02:SUB #16,R3 PAC ),R5 ADD #T30,SP ;NEITHER LETTER NOR DIGIT. SEV ;EXIT WITH V=1 RTS PC GET600: JMP GET601 ; ; ; GET40A: JMP GET40 ;INTERMEDIATE HELP GET03: MOV SP,R5 ;CALCULATE ADDR OF SYMBOL AREA ADD #T2,R5 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 �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� IX ; EXIT IF THROUGH CALL MULR50 ;NO, MULTIPLY MOV R0,-(SP) CALL RAD50C ADD (SP)+,R0 CALL MULR50 MOV R0,-(SP) CALL RAD50C BIC #100000,R0 ;CLEAR POSSIBLE NULL FLAG ADD (SP)+,R0 CLR MODE MOV R0,VALUE SETIMM STCODE ADD #2,(R4) BR 1$ RAD50C: CALL GETTCH BLE 1$ TSTR50 1$: RETURN ASCIZ: INC R0 ;SET Z FLAG .ENDC ASCII: MOV R0,-(SP) ;SAVE FLAG 1$: CALL GETTCH ;GET A TEXT CHARACTER BGE 2$ ;BRANCH IF OK DEC (SP) ;THROUGH, ASCIZ, FIRST TIME? BLT 3$ ; NOK03:SUB #11,R3 PACK04:SUB #11,R3 ; MULT R2 BY 40. PACK07: ASL R2 ;2*R2 ASL R2 ;4*R2 ASL R2 ;8*R2 MOV R2,-(SP) ;STACK 8*R2 ASL R2 ;16.*R2 ASL R2 ;32.*R2 ADD (SP)+,R2 ;40.*R2 ; INCLUDE CURRENT CHARACTER ADD R3,R2 INC R4 ;DONE 3 CHARS? BLT PACK05 ;NO MOV R2,(R0)+ ;YES-STORE MOD40 WORD INC R5 ;DONE 2 WORDS? BLT PACK01 ;NO TST (SP)+ ;DISCARD SWITCH RTS PC ;EXIT ; PACK08: DEC R1 ;DON'T USE THIS CHAR PACK10: INC @SP ;SET TERMINATION FLAG CLR R3 ;USE ZERO FILL FOR RES;RECALL POINTER TO TERMINATOR JSR PC,GEFUN ;SHOULD WE DECLARE THIS ITEM ;TO BE A FUNCTION? ; IF THIS IS THE NAME OF THE 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 G .TITLE TABF4 .IDENT /0607/ ;RFB ; ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; ; PDP-11 FORTRAN IV ; LANGUAGE-SPECIFIC IMPURE STORAGE AREA ; .NLIST BEX .GLOBL LINENO,CURLN .GLOBL MAIN,HDR .GLOBL EXEC,BLKDAT,BLKD,TLINE .GLOBL IMPTAB,PAUSSP,STKCNT,FLAGS,TYPSIZ .GLOBL FLABL,MODNAM,SEQNO,ARYASG,ROUTIN .GLOBL FNSTK,TEMP,RPC,DPC,RLAB,DLAB,ADBFLG .GLOBL  BIC #100000,R0 2$: CLR MODE MOV R0,VALUE SETIMB STCODE INC (R4) BR 1$ 3$: TST (SP)+ ;CLEAR Z FLAG ASCIIX: RETURN GETTCH: ;GET TEXT CHARACTER TST R3 ;ANYTHING IN PROGRESS? BNE 2$ ; YES 1$: TST R5 ;NON-NULL? BEQ 6$ ; NOPE, WE'RE THROUGH CMP R5,#CH.SMC ;ASCII, TEST FOR INVALID DELIMITERS BEQ 6$ CMP R5,#CH.LAB ; "<" BEQ 3$ ;EXPRESSION MOV R5,R3 ;VALID, SET DELIMITER 2$: GETCHR ;GET THE NEXT CHARACTER MOV R5,R0 BEQ 5$ ; ERROR IF INVALID CMP R0,R3 ;DET BR PACK07 ; PACK09: CMPB #'.,R3 ;"." BEQ PACK03 CMPB R3,#'0 BLT PACK08 CMPB R3,#'9 BLE PACK03 ;"0" - "9" BR PACK08 ;NON-RAD50 ���������������������������������������� ; ; NXTCH - GET THE NEXT NON-BLANK CHARACTER IN THE R1 STRING ; INTO R2. REGISTERS CHANGED - R1,R2. ; NXTCH: MOVB (R1)+,R2 ;GET A CHARACTER CMPB #SPACE,R2 ;SKIP BEQ NXTCH ; BLANKS RTS PC ;RETURN WITH ANY NON-BLANK CHARACTER. ; ;CNXC: INPUT (R1)=CURRENT CHARACTER POINTER ; OUTPUT: (R1)=NEXT NON BLANK CHAR.ET072: MOV T16(SP),R4 ;RESTORE R4,R5 MOV T17(SP),R5 ; ;NORMAL EXIT ; GET071: 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 (SDOLST,DOEND,DOTMP,PARCNT,NAMSER .GLOBL STCLR,ENDCLR,ECNT .PSECT ZZZHGH ���������������������������������������� .SBTTL SWITCHES AND FLAGS .GLOBL ARYCHK,ERRFLG,SEQSUP .GLOBL LSTVAL,OPTLVL,SWVAL ; LSTVAL: .WORD 0; LISTING CONTROL: ; 0 - MINIMAL LISTING ; 1 - SOURCE LIST ONLY ; 2 - SOURCE AND OBJECT LISTING ; 3 - LIST EVERYTHING ! ; ; ; IN EACH OF THE FOLOWING 3 FLAG WORDS, ; THE EVEN BYTE IS THE FLAG ; A FULL WORD IS USED FOR COMPATIBILITY WITH RSX-D CSI ; SWITCH VALUE PROCESLIMITER? BNE 4$ ; NO GETNB ;YES, BYPASS IT CLR R3 ;CLEAR DELIMITER BR 1$ ;TRY FOR MORE 3$: CALL NSTEXP ;BRACKETS, PROCESS NESTED EXPRESSION CALL ABSTST ;MUST BE ABSOLUTE BLT 5$ 4$: TST R0 ;GOOD RETURN, SET FLAGS RETURN 5$: ERROR A 6$: CLR R3 ;CLEAN UP MOV #100000,R0 ;SET FALSE FLAG RETURN .IF NDF XFTN .SBTTL CONDITIONALS .GLOBL IIF IIF: ;IMMEDIATE HANDLERS CALL TCON ;TEST ARGUMENT TST R3 BMI 3$ ; BRANCH IF UNSATISFIED MOV CHRPNT,R1 ;KEEP TRACK  OR SAME AS ;INPUT, IF INPUT WAS NON BLANK ; OUTPUT: CONDITION CODES ARE SET BY ; A TSTB ON THE OUTPUT CHAR. ;CNXC1: SAME AS CNXC EXCEPT R1 IS BUMPED FIRST. CNXC1: INC R1 CNXC: CMPB #' ,@R1 BEQ CNXC1 TSTB @R1 RTS PC ����������������������������������������; ; OTOA - OCTAL IN R3 CONVERTED TO ASCII ; STRING POINTED TO BY R2 ; REGISTERS CHANGED - R2,R3,R4. ; OTOA: MOV #2230,R4 ;SET LP CNT & 1ST DIG. BITS OTOA01: ASL R3 ;GET A BIT ROLB R4 ;MOVE INTO ASCII DIGIT BCC OTOA01 ;MARKER YEP),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 CONSSING. ; ERRFLG: .WORD 0 ;NON-ZERO FOR FANCY ERROR LISTINGS SEQSUP: .WORD 0 ;NON-ZERO IF SUPPRESS SEQUENCE ARYCHK: .WORD 0 ;NON-ZERO FOR SUBSCRIPT CHECKING ; ; OPTLVL: .WORD 0 ;OPTIMIZATION LEVEL ; ;SWITCH BIT LIST ; ; SWITCH BIT ASSIGNMENTS ARE DETERMINED BY LOCALS IN 'INIT/XINIT' ; SWVAL: 0+.-. ECNT: 0 ;COMPILATION ERROR COUNT ; ; BUFFER FULL FLAG, SET WHEN NON-CONTINUATION LINE ; IS FOUND IMMEDIATELY AFTER CONTINUATION LINE ; CURLN: 0 ���������������������������������������� .SBTTLOF LOCATION TSTCOM ;OK, BYPASS ANY COMMA BEQ 1$ ;BRANCH IF NO COMMA TSTB (R1)+ ;COMMA, MOVE PAST IT 1$: BIT #LC.CND,LCMASK ;CONDITIONAL SUPPRESSION? BEQ 2$ ; NO MOV R1,LCBEGL ;YES, SUPPRESS ALL UP TO COMMA 2$: JMP STMNT ;BACK TO STATEMENT 3$: CLR R5 ;FALSE, BUT NO "Q" ERROR BR ENDCX .GLOBL IFEQ, IFGE, IFGT, IFLE, IFLT, IFNE .GLOBL IFDF, IFNDF IFEQ: ;CONCATENATED CONDITIONALS IFGE: IFGT: IFLE: IFLT: IFNE: IFDF: IFNDF: MOV SYMBOL+2,SYMBOL ;TREAT SECOND HALF AST? MOVB R4,(R2)+ ;IF SO STORE CHARACTER CLRB R4 ;RESET MARKER BISB #23,R4 ;AND RESET ASCII BITS ASL R4 ;6 DIGITS DONE?? BCC OTOA01 ;NO RTS PC ;YES - EXIT ����������������������������������������; ; SCAN2A - SUB. TO COMPARE CH. STRING SUPPLIED WITH POINTER ; IN R1, WITH A PROTOTYPE LIST POINTED TO BY R0. ; UPON RETURN, IF SUCCESSFUL, R0 CONTAINS AN INDEX ; INTO A WORD-LENGTH LIST CORRESPONDING TO THE STRING ; FOUND. ; IF UNSUCCESSFUL, R1 IS LEFT UNCHANGED AND THE V-BIT IS ; SETTANTS? 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 ;CHECK IF MATCHING ENTRY MODE MATCHES T MISCELLANY ; ; MAIN PROGRAM HEADER NAME ; MAIN: .ASCIZ /MAIN./ ; ; BLOCK DATA HEADER NAME ; BLKD: .ASCIZ /DATA./ ; ; .GLOBL TTLCNT,FDGE,RDDEV,WTDEV,FAKE TTLCNT: .BYTE 0 ;SET TO 1 IF TITLE HAS BEEN TYPED FAKE: FDGE: .BYTE '1,0 ;CONSTANT 1 FOR DEFAULT STEP IN "DO" RDDEV: .BYTE '4,0 ;CONSTANT 4 FOR SPECIAL INPUT IN "IOSTMT" WTDEV: .BYTE '5,0 ;CONSTANT 5 FOR SPECIAL OUTPUT IN "IOSTMT" .GLOBL RUNFG,RUNCT,RUNER RUNFG: .BLKB ;NON-ZERO IF /GO RUNCT: .BLKB ;/GO COUNT RUNER: .BLKB ;FATAL E ARGUMENT CALL TCONF ;EXAMINE IT BR IF1 ;INTO THE MAIN STREAM .GLOBL IF, IFT, IFF, IFTF, ENDC IF: ;MICRO-PROGRAMMMED CONDITIONAL CALL TCON ;TEST ARGUMENT IF1: MOV #CNDLVL,R1 ;POINT TO LEVEL CMP (R1),#15. ;ROOM FOR ANOTHER? BGT IFOERR ; NO, ERROR INC (R1) ;YES, BUMP LEVEL ASL R3 ;SET CARRY TO TRUE (0) OR FALSE (1) ROR -(R1) ;ROTATE INTO CNDMSK ASL R3 ROR -(R1) ;DITTO FOR CNDWRD BR ENDCX IFT: ;IF TRUE SUB-CONDITIONAL MOV CNDMSK,R3 ;GET CURRENT BR IFTF ; . ; REGISTERS CHANGED - R0,R1,R2,R3. ; SCAN2A: MOV R4,-(SP) MOV R5,-(SP) MOV R0,R3 ;REMEMBER START OF TABLE SCAN2B: MOV (R0)+,R2 ;NEXT PROTOTYPE POINTER TO R2 TST @R0 ;SEE IF LIST IS ENDED BEQ SCAN5 ;EXIT IF FAILURE IN SEARCH MOV R1,R4 ;SET TEXT POINTER SCAN3: MOVB (R4)+,R5 ;GET A CHARACTER CMPB R5,#SPACE ;IGNORE BEQ SCAN3 ; SPACES CMPB R5,(R2)+ ;DOES IT MATCH PROTOTYPE??? BNE SCAN2B ;NO, TRY FOR NEXT ONE CMP R2,@R0 ;IS PROTOTYPE DONE? BLO SCAN3 ;NO SUB R3,R0 ;YES, GEHAT 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: JSR PC,GETRTR MOV T15(SP),R0 ;PTR TO REAL,DOUBLE VALUE BR GET073 RROR FLAG .EVEN ; ; DIAGNOSTIC TABLE ; ;WORD 1 - CONTENTS OF R1 AT TIME OF ERROR ;WORD 2 - ERROR NUMBER ; ONLY TEN ENTRIES ARE ALLOWED HERE ; THE ELEVENTH ENTRY IS FIXED TO POINT TO THE OVERFLOW MESSAGE ; ERRCUR: 0 ;POINTER TO CURRENT DIAG. ENTRY ERRS: .BLKW 20 ;ROOM FOR TEN ENTRIES ERREND = . .WORD 0,121. ;TABLE OVERFLOW DIAGNOSTIC .GLOBL ERRCUR,ERRS,ERREND ; ;START OF AREA TO BE CLEARED ; STCLR: ; ; MODULE NAME IN RADIX50 ; MODNAM: 0,0 ; ; BLOCK DATA FLAG SET IF BLOCK DATA ROU! AND BRANCH IFF: ;IF FALSE SUB-CONDITIONAL MOV CNDMSK,R3 ;GET CURRENT CONDITION COM R3 ;USE COMPLEMENT AND FALL THROUGH IFTF: ;UNCONDITIONAL SUB-CONDITIONAL ;(R3=0 WHEN CALLED DIRECTLY) TST CNDLVL ;CONDITIONAL IN PROGRESS? BLE IFOERR ; NO, ERROR ASL CNDWRD ;MOVE OFF CURRENT FLAG ASL R3 ;SET CARRY ROR CNDWRD ;MOV ON BR ENDCX ENDC: ;END OF CONDITIONAL MOV #CNDLVL,R1 ;POINT TO LEVEL TST (R1) ;IN CONDITIONAL? BLE IFOERR ; NO, ERROR DEC (R1) ;YES, DECRE"T TABLE INDEX TST -(R0) ;FUDGE THE COUNT MOV R4,R1 ;AND ADVANCE STRING POINTER MOV (SP)+,R5 MOV (SP)+,R4 RTS PC ;RETURN TO CALLER WITH SUCCESS SCAN5: MOV (SP)+,R5 MOV (SP)+,R4 SEV ;SET OVERFLOW IF NOT FOUND RTS PC ;AND RETURN SADLY ����������������������������������������; ; ; MOD40 UNPACK ; ; INPUT: R0=ADR OF MOD40 NUMBER(2 WORDS) ; R1=ADR OF ASCII STRING(6 BYTES) ; ; OUTPUT: R1 POINTS ONE PAST LAST GENERATED CHAR. ; ; IF N IS THE MOD40 NUMBER, THEN ; N=C1*40^2+C2*4#; 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 SERIAL # JSR PC,OTOA MOV #"$I,T2(SP) INC IIII MOV T18(SP),R0 BIS #2,LENWD(R0) ;LENGTH BIS #004000,D$TINE ; BLKDAT: 0 ; ; EXECUTABLE STATEMENT FOUND FLAG ; EXEC: 0 ; ; HEADER GENERATED FLAG - SET WHEN PROGRAM, SUBROUTINE ; OR FUNCTION HEADER IS GENERATED FOR FIRST TIME ; HDR: 0 ; ; LINE NUMBER IN ASCII. IF FIRST BYTE IS ZERO, ; NO LINE NUMBER EXISTS ; LINENO: 0,0,0 ;PERMANENT LINE NUMBER TLINE: 0,0,0 ;TEMPORARY LINE NUMBER - ONLY FORTION USES IT PAUSSP: 0 ;PAUSE AND STOP TEMPORARY ; EXPRESSION EVALUATOR ROUTINES ; STKCNT: 0 FLAGS: 0 FLABL: 0 ;INTERNAL LABEL CELL SLABL: 0 ;L%MENT ASL -(R1) ;REDUCE MASK ASL -(R1) ; AND TEST WORD ENDCX: BIS #LC.CND,LCFLAG ;MARK CONDITIONAL RETURN IFOERR: ERROR O ;CONDITION ERROR RETURN TCON: ;TEST CONDITION TSTCOM ;BYPASS ANY COMMA GETSYM ;GET A SYMBOL TCONF: SCANW CNDROL ;SCAN FOR ARGUMENT BEQ IFAERR ; ERROR IF NOT FOUND TSTCOM ;BYPASS COMMA MOV SYMBOL+2,R0 ;GET ADDRESS ASR R0 ;LOW BIT USED FOR TOGGLE FLAG SBC R3 ;R3 GOES TO -1 IF ODD ASL R0 ;BACK TO NORMAL (AND EVEN) TST CNDWRD ;ALREADY UNS&0+C3 ; THUS N/40^2 IS C1 AND THE REMAINDER IS C2*40+C3 ; THE REMAINDER IS DIVIDED BY 40 TO GET C2, ETC. ; ; REGISTERS CHANGED - R1 ; .GLOBL UNPK00 UNPK00: MOV R0,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) MOV #-2,R4 ;MAJOR LOOP COUNT UNPK07: MOV #-3,R5 ;MINOR LOOP COUNT MOV (R0),R0 ;GET MOD40 WORD MOV #COEFF,R2 ;PTR TO COEFFICIENTS UNPK06: CLR R3 ;0 QUOTIENT ; DIVIDE BY QUOTIENTS UNPK02: CMP R0,(R2) ;DONE WITH DIVIDE? BLO UNPK01 ;YES SUB (R2),R0 ;NO, SUB'ATYWD(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 SYMBO(ABEL CELL USED BY $TR,$SNNN IN DATA ET AL .GLOBL SLABL SEQNO: 0 ;STATEMENT SEQUENCE NUMBER ARYASG: 0 ;ARRAY ASSIGNMENT FLAG ROUTIN: 0 ;=0 FOR MAIN PROGRAM ;=1 FOR SUBROUTINE ;=2 FOR FUNCTION NAMSER: 0 ;0 IF MAIN ;NONZERO MEANS SERIAL NUMBER OF NAME ����������������������������������������; ; FAKE SYMBOL TABLE ENTRY FOR FUNCTION NAME ; SYMSER: 0,0,0,0,0,0,0 .GLOBL SYMSER PARCNT: 0 TEMP: 0 ;TEMPORARY CELL USED DURING EXPRESSION EVALUATION FNSTK: ;STACK DEPTH DURING A FUNC)AT? BNE IFAERX ; YES, JUST EXIT JMP @R0 ;NO, EXIT THROUGH HANDLER IFAERR: ERROR A IFAERX: RETURN .MACRO GTCON TRUE, FALSE, ADDRESS .RAD50 /TRUE/ .WORD ADDRESS .RAD50 /FALSE/ .WORD ADDRESS+1 .ENDM CNDBAS: ;CONDITIONAL SCAN TABLE GTCON EQ, NE, TCONEQ GTCON GT, LE, TCONGT GTCON LT, GE, TCONLT GTCON DF, NDF, TCONDF CNDTOP: TCONEQ: ABSEXP ;EQ/NE, TEST EXPRESSION BEQ TCONTR ;BRANCH IF SAT TCONFA: COM R3 ; FALSE, TOGGLE TCONTR: RETURN ;TRUE, JUST EXIT T*TRACT COEFF. INC R3 ;ADD ONE TO QUOTIENT BR UNPK02 ; DIVIDE DONE. QUOT. IN R3, REMAINDER IN R0 ; CONVERT TO AN ASCII CHARACTER UNPK01: TSTB R3 BEQ UNPK03 ;"BLANK" CMPB R3,#33 BEQ UNPK05 ;"$" BGT UNPK04 ;"." OR "0-9" ADD #40,R3 ;"A-Z" UNPK03: ADD #16,R3 UNPK04: ADD #11,R3 UNPK05: ADD #11,R3 MOVB R3,(R1)+ ;STORE CHARACTER TST (R2)+ ;ADVANCE COEFF. INC R5 ;3 CHARS DONE?? BLT UNPK06 ;NO, DO MORE MOV 10(SP),R0 ;RESTORE R0 AND TST (R0)+ ;MOVE TO NEXT WORD INC R4 ;DONE +L 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 HOLLE,TION CALL . = .+42. .GLOBL DEPTH DEPTH: .BYTE 0 ;MAXIMUM DEPTH IN EXPRESSION .GLOBL GOFLG GOFLG: .BYTE 0 ;GOTO MARKER .GLOBL ENDFND; ENDFND: .BYTE 0; 'END' STATEMENT FOUND FLAG .EVEN ; ; TEMPORARIES USED IN END PROCESSING ; RPC: 0 DPC: 0 RLAB: 0 DLAB: 0 ADBFLG: 0 ; ; I/O TEMPORARIES ; .GLOBL LSTMOD,COUNT,DONUM,IOL,INHLAB .GLOBL LSTOUT,CUROUT LSTOUT: .BLKB CUROUT: .BLKB LSTMOD: 0 COUNT: 0 DONUM: 0 IOL: 0 INHLAB: 0 ;INHIBIT LABEL GENERATION FOR IF ; ; DO TABLE - CONTAIN-CONGT: ABSEXP BGT TCONTR BR TCONFA TCONLT: ABSEXP BLT TCONTR BR TCONFA TCONDF: ;IF/IDF MOV R3,R1 ;SAVE INITIAL CONDITION CLR R2 ;SET "&" CLR R3 ;START OFF TRUE 1$: GETSYM ;GET A SYMBOL BEQ IFAERR ; ERROR IF NOT A SYM SSRCH ;SEARCH USER SYMBOL TABLE CLR R0 ;ASSUME DEFINED BIT #DEFFLG,MODE ;GOOD GUESS? BNE 2$ ; YES COM R0 ;NO, TOGGLE 2$: CMP R0,R3 ;YES, MATCH? BEQ 3$ ; YES, ALL SET MOV R2,R3 ; NO COM R3 3$: MOV R1,R2 ;ASSUME "&" CMP R5,#CH.AND.TWO WORDS? BLT UNPK07 ;NO MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R0 RTS PC ;YES, QUIT ; ; COEFFICIENT TABLE ; COEFF: 1600. ;40^2 40. ;40^1 1. ;40^0 .GLOBL CHKOCT,CHKHEX,ZLEQLS .GLOBL OUTOCT,OUTST,OUTSTR ; ; ; ; ; OUTOCT ; ; OUTPUT THE NUMBER IN R3 TO THE OBJECT DEVICE ; ALWAYS GENERATES 6 CHARS ; AS ASCII OCTAL EQUIVALENT ; REGISTERS CHANGED - R3 ; OUTOCT: MOV R2,-(SP) ;SAVE R2 MOV R4,-(SP) MOV R5,-(SP) ADD #-6,SP ;CLAIM/RITH 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 MOVE0S ACTIVE DO ENTRIES ; ONLY ACTIVE ENTRIES ARE CONTAINED IN THIS TABLE, ; INACTIVE ENTRIES MUST BE REMOVED ; DOLST: . = .+214 ;ROOM FOR TEN ENTRIES DOEND = . DOTMP: 0,0,0,0,0,0,0 ;DO STATEMENT TEMPORARY ���������������������������������������� .SBTTL SYMBOL TABLE VARIABLES ; ; SYMBOL TABLE POINTERS, ETC. ; .GLOBL ADBCUR,CCCC,CURSYM,DDDD,GETSW .GLOBL IIII,LSTCHN,MMMM,MOD40,NOCNSV,RRRR,SERIAL ; LSTCHN: 0 ;ADDRESS OF LAST ENTRY REFERENCED IN TABLE MOD40: 0,0 ;MOD 40 WORK AREA CURSYM: 0 ;ADD1 ; "&" BEQ 4$ ; BRANCH IF GOOD GUESS CMP R5,#CH.IOR ;PERHAPS OR? BNE 5$ ; NO COM R2 ;YES, TOGGLE MODE 4$: GETNB ;BYPASS OP BR 1$ ;TRY AGAIN 5$: TST R1 ;IFDF? BEQ 6$ ; YES COM R3 ;NO, TOGGLE 6$: RETURN .CSECT IMPPAS ;CONDITIONAL STORAGE (MUST BE ORDERED) CNDWRD: .BLKW ;TEST WORD CNDMSK: .BLKW ;CONDITION MASK CNDLVL: .BLKW ;NESTING LEVEL .CSECT .SBTTL LISTING CONTROL .GLOBL NLIST, LIST NLIST: COM R3 ;MAKE R3 -1 LIST: 1$: TSTARG ;TEST FOR AN2 6 BYTES OF STACK MOV SP,R2 ;OUTPUT ADDRESS FOR 'OTOA' ROUTINE JSR PC,OTOA ;CONVERT TO TEXT MOV SP,R4 ;ADDRESS FOR OUTPUT ROUTINES MOV #6,R5 ;COUNT FOR 'OUTLN' JSR PC,OUTLN ;BYE, BYE? ADD #6,SP ;PICK-UP AFTER THE PARTY MOV (SP)+,R5 MOV (SP)+,R4 MOV (SP)+,R2 RTS PC ; ; OUTST ; ; OUTPUT THE ASCII NAME OF A VARIABLE TO THE ; OBJECT DEVICE GIVEN THE ADDRESS IN THE ; SYMBOL TABLE IN R0 ON ENTRY. ; REGISTERS CHANGED - NONE ; OUTSTR: ADD SYMBAS,R0 OUTST: MOV R4,-(SP)3 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 4RESS OF CURRENT ENTRY SERIAL: 0 ;CURRENT SERIAL #(INC BY 1 FOR NEXT ENTRY) ADBCUR: 0 ;ADB ADDRESS MOST RECENTLY ENTERED INTABLE GETSW: .BYTE 0 ;GET CONTROL SWITCH NOCNSV: .BYTE 0 ;CONSTANT SUPPRESSION SWITCH .EVEN IIII: 0 RRRR: 0 DDDD: 0 CCCC: 0 MMMM: 0 ; ;CELLS FOR FORCOM, FORDAT, FORASF ; .GLOBL EQVH3,EQVDEL,FNCTYP EQVH3: 0 EQVDEL: 0 .GLOBL FAKSYM,DATTYP,DATVST FAKSYM: .BLKB 34 ;FAKE SYMBOL TABLE ENTRY USED BY DATA DATTYP: 0 DATVST: 0 ;ASF FUNCTION TYPE FNCTYP: 0 �������������5OTHER ARGUMENT BEQ 2$ ; FINISHED GETSYM ;TRY FOR A SYMBOL SCANW LCDROL ;LOOK IT UP IN THE TABLE BEQ 4$ ;ERROR IF MISSING OR NOT A SYMBOL CLR R2 SEC 10$: ROL R2 DEC R0 BGT 10$ BIC R2,LCMASK TST R3 BEQ 11$ BIS R2,LCMASK 11$: BR 1$ ;TRY FOR MORE 2$: TST ARGCNT ;ANY ARGS? BNE 3$ ; YES ASL R3 ;NO, MAKE R3 0 OR -2 INC R3 ;NOW 1 OR -1 ADD R3,LCLVL ;UPDATE LEVEL COUNT 3$: RETURN 4$: ERROR A RETURN .MACRO GENLCT MNE ;GENERATE LISTING CONTROL TABLE LC.'MNE=6 ;YES MOV R5,-(SP) ;LIKEWISE MOV R1,-(SP) MOV R0,-(SP) MOV SP,R4 ;REMEMBER END OF SYMBOL ADD #SYM1WD,R0 ;GET ADDRESS OF PACKED SYMBOL SUB #6,SP ;NEED 6 BYTES FOR THE UNPACKER MOV SP,R1 ;TELL WHERE TO UNPACK JSR PC,UNPK00 ;UNPACK IT ; MUST SCRAP TRAILING BLANKS MOV #7,R5 ;START AT 6 CHARS OUTST1: DEC R5 ;AND COUNT DOWN CMPB #' ,-(R4) ;A BLANK BEQ OUTST1 ;MUST TERMINATE FOR LEGAL SYMBOLS MOV SP,R4 ;BASE OF SYMBOL JSR PC,OUTLN ;OUTPUT ADD #6,SP ;CLEAN HOUSE MOV (SP)+,R7CONST? 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 GET518��������������������������� .SBTTL .GLOBL BYTE TABLES .GLOBL GL1,GL2,CV1,MISC,BITM,PUTWK,PUTA ; ; BYTE TABLE OF GLOBALS ; ; BIT POSITIONS ARE ASSIGNED AS FOLLOWS: ; BIT MODE ; 0 0 - B ; 1 1 - I ; 2 2 - I ; 3 3 - R ; 4 4 - D ; 5 5 - C ; 6 6 ; 7 7 ; ; ; GL1: .BYTE 0 ;POP .BYTE 0 ;SBS .BYTE 0 ;PUT .BYTE 0 ;GET .BYTE 0 ;PSHR .BYTE 0 ;POPP .BYTE 0 ;POPR GL2: .BYTE 0 ;OR .BYTE 0 ;AND .BYTE 0 ;NOT .BYTE 0 ;ADD .BYTE 0 ;SUBTRACT .BYTE 0 ;MULTIPLY .BYTE 0 ;DIV9 XXX XXX= XXX+XXX .RAD50 /MNE/ .ENDM XXX= 1 LCTBAS: GENLCT SEC GENLCT LOC GENLCT BIN GENLCT SRC GENLCT COM GENLCT BEX GENLCT MD GENLCT MC GENLCT ME GENLCT MEB GENLCT CND GENLCT LD GENLCT TTM GENLCT TOC GENLCT SYM LCTTOP: .ENDC .CSECT IMPURE LCMASK: .BLKW ;MASK BYTES LCLVL: .BLKW ;LEVEL COUNT .CSECT IMPLIN LCFLAG: .BLKW ;FLAG BYTES LCBEGL: .BLKW ;POINTER TO START OF LINE LCENDL: .BLKW ;POINTER TO END OF LINE LBLEND: .BLKW ;END OF LAB:0 MOV (SP)+,R1 MOV (SP)+,R5 MOV (SP)+,R4 RTS PC ; ; OUTSER ; ; OUTPUT THE SERIAL NUMBER IN R3 PREFIXED BY ; $X, WHERE X IS THE ASCII CHARACTER IN R0 ; .GLOBL OUTSER OUTSER: MOV R2,-(SP) ;SAVE R2 MOV R4,-(SP) ;AND R4 MOV R5,-(SP) ;AND R5 SUB #6,SP ;MAKE ROOM ON THE STACK MOV SP,R2 ;GET ADDRESS FOR CONVERSION JSR PC,OTOA ;CONVERT TO ASCII MOVB #'$,-6(R2) ;ADD THE $X MOVB R0,-5(R2) ; PREFIX MOV SP,R4 ;OUTPUT MOV #6,R5 ; THE JSR PC,OUTLN ; CHARACTERS ADD #6,SP ;RE;9: 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 COUN<IDE .BYTE 0 ;EXPONENTIATE .BYTE 0 ;NEGATE .BYTE 0 ;.LT. .BYTE 0 ;.EQ. .BYTE 0 ;.NE. .BYTE 0 ;.LE. .BYTE 0 ;.LE. .BYTE 0 ;.GE. .BYTE 0 ;$CM ; ; CONVERSION TABLE ; CV1: .BYTE 0 ;B .BYTE 0 ;I .BYTE 0 ;I .BYTE 0 ;R .BYTE 0 ;D .BYTE 0 ;C ����������������������������������������; ; MISCELLANEOUS MODES ; ; BYTE 0 ; BIT NAME ; 0 $SVSP ; 1 $PSH ; 2 $RET ; 3 $SVA ; 4 $TR ; 5 $TRX ; 6 $TRAL ; 7 $TRA ; ; BYTE 1 ; BIT NAME ; 0 $ASP ; 1 $AS ; 2 $PSHP ; 3 =EL (FOR PARSING) .CSECT .SBTTL LISTING STUFF SETPF0: SAVREG MOV #CLCLOC,R1 MOV #OCTBUF+2.,R2 BR SETWRD ;LIST WORD SETPF1: CLR R0 SETPFB: SAVREG MOV #VALUE,R1 MOV #OCTBUF+9.,R2 CALL @SETPFT(R0) ;WORD OR BYTE SETPFF: BIT #GLBFLG!RELFLG,-(R1) BEQ 2$ MOVB #CH.XCL,(R2) ; "'" BIT #GLBFLG,(R1) BEQ 2$ MOVB #'G,(R2) 2$: RETURN SETPFT: .WORD SETWRD, SETBYT ;WORD OR BYTE TABLE SETWRD: MOV R1,-(SP) ;STACK REG MOV (R1),R1 ;GET ACTUAL VALUE MOVB #'0/2,(R2) ;SET PRIMITIV>STORE THE STACK MOV (SP)+,R5 ;RESTORE MOV (SP)+,R4 ; THE MOV (SP)+,R2 ; REGISTERS RTS PC ����������������������������������������; VARIOUS CHECK ROUTINES ; ; INPUT: R1 POINTS TO CHAR TO BE CHECKED ; OUTPUT: V=0 => CHAR IS OK FOR THAT TYPE ; V=1 => CHAR NOT OF THAT TYPE ; R5 = BINARY VALUE OF CONVERTED CHAR ; ; CHKOCT - CHECK FOR OCTAL DIGIT (0-7) ; CHKHEX - CHECK FOR HEX DIGIT (0-F) ; CHKOCT: CMPB @R1,#'0 ;LOOK FOR OCTAL DIGIT BLT CHKOC1 ;SET V IF NOT FOUND CMPB @R1,#'7 ;MAKE ?T 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 INDICATO@$ENDDO ; 4 $ENDDP ; 5 $SVP OR $SVPA ; 6 $SVE ; ; BYTE 2 ; BIT NAME ; 0 $FIND ; 1 $INI ; 2 $INFI ; 3 $INRI ; 4 $OUTI ; 5 $OUTFI ; 6 $OUTRI ; 7 $IOF ����������������������������������������; ; BYTE 3 ; BIT NAME ; 0 $IOB ; 1 $IOL ; 2 $IOI ; 3 $IOR ; 4 $IOD ; 5 $IOC ; 6 NONE ; 7 $IOA ; ; BYTE 4 - TO BE GENERATED AT END ; BIT NAME ; 0 $READ ; 1 $WRITE ; 2 $DC - DOUBLE, REAL CONVERSION ; 3 $IC - INTEGER, OCTAL CONVERSION ; 4 $LC - LOGICAL CONVERSION ; 5AE ASL R1 ROLB (R2)+ ;MOVE IN BIT MOV #5,R0 BR SETBYX SETBYT: MOV R1,-(SP) ;STACK INDEX MOVB (R1),R1 ;GET VALUE MOV #SPACE,R0 MOVB R0,(R2)+ ;PAD WITH SPACES MOVB R0,(R2)+ MOVB R0,(R2)+ SWAB R1 ;MANIPULATE TO LEFT HALF RORB R1 ;GET THE LAST GUY CLC ROR R1 MOV #3,R0 SETBYX: SWAB R0 ADD #3,R0 MOVB #'0/10,(R2) 1$: ASL R1 ROLB (R2) DECB R0 BGT 1$ TSTB (R2)+ SWAB R0 DEC R0 BNE SETBYX MOV (SP)+,R1 RETURN .SBTTL KEYBOARD HANDLERS .IF NDF XFTN ENDP1BSURE IT IS NOT TOO BIG BGT CHKOC1 CHKOC2: MOVB @R1,R5 ;RETURN VALUE IN R5 SUB #'0,R5 CLV RTS PC CHKOC1: SEV RTS PC ; ; CHECK FOR HEX ; CHKHEX: CMPB @R1,#'0 BLT CHKHE1 CMPB @R1,#'9 BLE CHKOC2 ;OK IF A DIGIT CMPB @R1,#'A BLT CHKHE1 CMPB @R1,#'F BLE CHKHE2 ;OK IF LETTER A-F CHKHE1: SEV RTS PC CHKHE2: MOVB @R1,R5 SUB #'A-10.,R5 ;HEX VALUE CLV RTS PC ; ����������������������������������������; ; GENERATE STATEMENT LABEL FOR EXECUTABLE STATEMENT ; .GLOBL SEQSUP CR (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) BNE GET35 JMP GET25 ;JUMP IF H CONSTANT GET24: TRAP+13. ;ILLEGAL FORMAT JMP GET09 GET21: CMPB (R1),#'. ;CHECK TERMINATD ENCODE ; 6 DECODE ; ; BYTE 5 ; BIT NAME ; 0 $ENCD ; 1 $DECD ; ; BYTE 6 ; BIT NAME/USE ; 0 $ACIO ;FLAG A FORMAT OCCURRENCE ; 1 ; 2 XXX ;FLAG $TR,$SNNNN GENERATED ; 3 XXX ;FLAG .=$PC NEEDED IN DATA ; 4 $CALL ; 5 $CALLP ; 6 XXX ;INIT FLAG USED BY CODGEN ; 7 $PA ; MISC: .BLKB 8. ;MISCELLANEOUS MODES ����������������������������������������; ; EXPONENTIATION GLOBAL MAP ; ; BYTE BASE MODE ; 0 B (NOT ALLOWED) ; 1 I ; 2 I ; 3 R ; 4 D ; 5 C ; ; BIT EXPONENT MODE ; 0 EM: .ASCIZ <CR><LF>/END OF PASS 1/ .EVEN .CSECT MIXED HASH: .WORD 4,0,4 .BYTE CR,LF,'#,VT .EVEN .WORD 0 CODLNK: .WORD 0 ;KB OUTPUT LINK .RAD50 /CMO/ .WORD 1 .RAD50 /KB/ .WORD 0 CIDLNK: .WORD 0 ;KB INPUT LINK .RAD50 /CMI/ .WORD 1 .RAD50 /KB/ .CSECT IMPURE CIDLEN= 83. CMDBUF: .BLKW 7. ;COMMAND BUFFER HEADER CIDHDR: .BLKW 3 CIDBUF: .BLKW <CIDLEN+1>/2 CMDSAV: .BLKW 7. CSISAV: .BLKW .CSECT .ENDC .SBTTL OBJECT CODE HANDLERS ENDP: ;END OF PASS HFGENLAB: TST INHLAB ;IS THE LABEL NEEDED OR DESIRED? BNE LABEZ ;NOT AT ALL MOV R3,-(SP) MOV R4,-(SP) MOV #LINENO,R4 ;GET ADDRESS OF LINE NUMBER TSTB @R4 ;IS THERE A LINE NUMBER BEQ LABEX ;NO CLRB GOFLG ;TURN OFF PATH ERROR JSR R5,OUTCH2 ;OUTPUT A . '. JSR R5,OUTLN2 ;AND A LINE NUMBER LINENO TSTB SEQSUP ;SUPPRESS SEQUENCING?? BNE LABEA ;YES MOV #TERM,R4 ;GET TERMINATOR LABEY: JSR PC,OUTLN1 ;OUTPUT IT MOV SEQNO,R3 JSR PC,OUTOCT LABEB: JSR PC,EOL LABEC: MOV (SP)+,R4 GOR=. BEQ GET22A ;BR IF YES (CHECK FOR SPECIAL CASE) GET35: CMPB (R1),#'E ;IS THIS AN "E" BEQ GET27X ;OR CMPB (R1),#'D ;"D" CONSTANT? BEQ GET27X ;YES TST T15(SP) ;WAS INTEGER TOO BIG? BNE GET36Q ;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 ;CONSHB (NOT ALLOWED) ; 1 I ; 2 I ; 3 R ; 4 D ; 5 C (NOT ALLOWED) ; .GLOBL EXPMAP EXPMAP: .BLKB 6 .EVEN ENDCLR = . ;END OF AREA NEEDING CLEARING ; ; MASKS ; BITM: .BYTE 1 ;0 .BYTE 2 ;1 .BYTE 4 ;2 .BYTE 10 ;3 .BYTE 20 ;4 .BYTE 40 ;5 .BYTE 100 ;6 .BYTE 200 ;7 ; ; ; ; ; NAME TEMPORARY - USED BY GLOBAL GENERATOR ; PUTWK: PUTA ;POINTER TO TEMPORARY PUTA: .WORD 0,0,0,0,0,0 ;CAN'T HAVE MORE THAN 12 CHARS ; ���������������������������������������� .SBTTL IMPLICIT TABLE ;IIANDLER CALL SETMAX TST PASS ;PASS ONE? BNE ENDP2X ;BRANCH IF PASS 2 .IF NDF XFTN TST OBJLNK ;PASS ONE, ANY OBJECT? .IFF CALL BLKPRT ;OUTPUT THE DATA SUMMARY CMP LSTVAL,#2 BLT 33$ MOV #60.,LINCT CALL PAG 33$: TST LINKOL .ENDC BEQ 30$ ; NO MOV #BLKT01,BLKTYP ;SET BLOCK TYP1 1 CALL OBJINI ;INIT THE POINTERS MOV #PRGTTL,R1 ;SET "FROM" INDEX MOV RLDPNT,R2 ; AND "TO" INDEX CALL GSDDMP ;OUTPUT GSD BLOCK CLR -(SP) ;INIT FOR SECTOR SCAN 10$: MOV (SP)+,ROLUPD ;SET SJ MOV (SP)+,R3 LABEZ: RTS PC LABEA: JSR R5,OUTCH2 ;OUTPUT A COLON ': BR LABEB ;AND CONTINUE TERM: .ASCII /: $SEQ,/ .BYTE 0 .EVEN LABEX: TSTB GOFLG ;IS GO FLAG SET? .GLOBL GOFLG BEQ GENL01 ;NO CLRB GOFLG ;YES, CAN'T GET HERE TRAP+109. ;SO GIVE DIAGNOSTIC GENL01: TSTB SEQSUP ;SUPPRESS SEQUENCING? BNE LABEC ;YES MOV #TERM+1,R4 BR LABEY ; ; ZLEQLS ; ; CHECK FOR ZEROTH LEVEL = SIGN IN INPUT LINE. NOTE ; THAT A ZERO LEVEL COMMA OR SLASH ARE ASSUMED ; TO IMPLY THAT NO ZERO LKTRUCT 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 LMPLICIT TABLE - INITIALIZED TO STANDARD FORTRAN IMPLICIT ASSIGNMENTS ;BITS 5-3 OF THE BYTE CONTAINS THE DATA TYPE. IMPTAB: .BLKB 26. .EVEN ; ;TABLE TO CONVERT FROM DATA TYPE TO DATA SIZE ; TYPSIZ: .BYTE 1 ;LOGICAL - 1 .BYTE 4+.-. ;LOGICAL - 2 .BYTE 4+.-. ;INTEGER (MAY BE 4 IF TWO WORD INTEGERS) .BYTE 4 ;REAL .BYTE 10 ;DOUBLE PRECISION .BYTE 10 ;COMPLEX .BYTE 0 ;HOLLERITH - .BYTE 0 ;UNASSIGNED - ���������������������������������������� .SBTTL COMMON/EQUIVALENCE ; ;MCAN MARKER NEXT SECROL ;GET THE NEXT SECTOR BEQ 20$ ;BRANCH IF THROUGH MOV ROLUPD,-(SP) ;SAVE MARKER MOV #MODE,R1 MOV (R1),R5 ;SAVE SECTOR BIC #377,R5 ;ISOLATE IT SWAB R5 ; AND PLACE IN RIGHT BIC #-1-<RELFLG>,(R1) ;CLEAR ALL BUT REL BIT BIS #<GSDT01>+DEFFLG,(R1)+ ;SET TO TYPE 1, DEFINED MOV R5,(R1)+ ;ASSUME ABS BEQ 11$ ; OOPS! MOV (R1),-(R1) ; REL, SET MAX 11$: CLR ROLUPD ;SET FOR INNER SCAN 12$: MOV #SYMBOL,R1 CALL GSDDMP ;OUTPUT THIS BLOCK 13$: NEXT SYMROL ;FETCHNEVEL = WILL BE FOUND. ; ; INPUT: R1 - POINTS AT TEXT STRING ; OUTPUT: C=0 =>NONE FOUND ; C=1 =>ZEROTH LEVEL FOUND ; ; REGISTERS CHANGED - NONE. ; ZLEQLS: MOV R1,-(SP) CLR -(SP) ;WILL COUNT DEPTH HERE ZLEQL1: TSTB @R1 ;GET THE CHAR BEQ ZLEQLX ;JUMP IF END OF LINE CMPB #'',(R1) ;WATCH OUT FOR QUOTE STRINGS BEQ ZLX ;FOUND ONE!! CMPB #',,@R1 BEQ ZLEQLC CMPB #'/,@R1 BEQ ZLEQLC ;HAVE / CMPB #'=,@R1 BEQ ZLEQLE ;HAVE = CMPB #'(,@R1 BEQ ZLEQLL ;NAVE ( CMPB #'),@R1 BEQ ZO 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+15. ;INTEGER CONSTANT LARGER THAN ADMISSABLE BR GET351 GET36Q: JMP GET36 ;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 GET22A: BR GET22 ; ; HANDLE OCTAL CONSTANTS HERE ; GET601: INC R1 ;SKIP OVER " CLR T2(SPP VARIABLES INTRODUCED FOR THE COMMON AND ; EQUIVALENCE HANDLERS ; ; LOCADB (5 WORDS) - A TEMP LOCATION FOR AN ; ADB PRODUCED BY 'LSTITM' UNTIL ACCEPTED FOR ; USE. LOCADB: .WORD 0,0,0,0,0 ; BLKNAM (7 BYTES) - A TEMP LOCATION FOR A BLOCK ; NAME - UP TO SIX BYTES TERMINATED BY ZERO BLKNAM: .WORD 0,0,0,0 ; COMMON AND EQUIV TABLES ARE ALLOCATED SEPARATELY ; FROM REST OF SYMBOL TABLE TO FACILATATE RECOVERY ; COMHED - POINTER TO THE HEAD OF THE COMMON ; LIST STRUCTURE. COMHED: COMUN ;IQ THE NEXT SYMBOL BEQ 10$ ; FINISHED WITH THIS GUY BIT #GLBFLG,MODE ;GLOBAL? BEQ 13$ ; NO CMPB SECTOR,R5 ;YES, PROPER SECTOR? BNE 13$ ; NO BIC #-1-<DEFFLG!RELFLG!GLBFLG>,MODE ;CLEAR MOST BIS #GSDT04,MODE ;SET TYPE 4 BR 12$ ;OUTPUT IT 20$: NEXT ENDROL ;GET THE END VECTOR BIC #-1-<RELFLG>,MODE ;CLEAR ALL BUT REL FLAG BIS #GSDT03+DEFFLG,MODE MOV #SYMBOL,R1 CALL GSDDMP ;OUTPUT END BLOCK CALL PCRDMP ;DUMP IT MOV #BLKT02,BLKTYP ;SET "END OF GSD" CALL RLDDMP MOV #BLKT0RLEQLR ;HAVE ) ZLEQ1: INC R1 ;ADVANCE POINTER BR ZLEQL1 ;TO NEXT CHAR ; ZLEQLL: INC @SP ;UP THE PAREN COUNT BR ZLEQ1 ZLEQLR: DEC @SP ;DOWN THE PAREN COUNT BR ZLEQ1 ZLEQLE: TST @SP ;WE ARE DONE IF IT IS ZERO BNE ZLEQ1 ;KEEP SCANNING TST (SP)+ MOV (SP)+,R1 SEC ;DECLARE IT FOUND RTS PC ; ZLEQLC: TST @SP BNE ZLEQ1 ZLEQLX: TST (SP)+ MOV (SP)+,R1 CLC RTS PC ZLX: INC R1 ;SKIP OVER CHARACTER CMPB #'',(R1) ;CLOSING QUOTE FOUND? BEQ ZLEQ1 ;YES GO BACK TO LOOP TSTB (R1S) CLR T3(SP) MOV #1,T4(SP) ;SET TO INTEGER CLR T6(SP) CLR T15(SP) CLR R4 ;SET CHARACTER COUNT TO ZERO CLR R3 ;ACCUMULATE VALUE IN R3 GET603: JSR PC,NXTCH ;GET A CHARACTER SUB #60,R2 ;CONVERT TO OCTAL BMI GET604 ;NOT AN OCTAL CHARACTER CMP R2,#7 ;IS IT TOO BIG BGT BADOCT ;YES CLC ASL R3 ;MAKE ROOM FOR BCS OVF ASL R3 ;THE NEW BCS OVF ASL R3 ;DIGIT BCS OVF BIS R2,R3 ;PUT IN NEW DIGIT INC R4 ;ADVANCE CHARACTER COUNT BR GET603 BADOCT: CMP R2,#9. ;IS THIS A TNITIALLY ZERO .GLOBL COMUN,COMCLR COMUN: .WORD 0 ;LINK TO NEXT BLOCK .ASCII '.$$$$.' ;BLOCK NAME .WORD 0 ;NAME TERMINATOR COMCLR: .WORD 0 ;LINK TO ITEM ; EQVHED - POINTER TO HEAD OF EQV LIST STRUCTURE EQVHED: 0 ;INITIALLY ZERO COMNUM: .WORD 0 ; ;FOR DATA MODULE ; DATADB: .WORD 0 DATLAB: 0 DATVSV: 0 DATVCT: 0 DATCSV: 0 DATCCT: 0 ALOKAT: 0 .GLOBL DATVCT,DATLAB .GLOBL COMNUM,DATADB,DATVSV,DATCSV,DATCCT,ALOKAT EQVH1: .WORD 0 EQVH2: .WORD 0 EQVCLS: .WORD 0 EQVCOM: .WORD 0 .GLU4,BLKTYP ;INIT FOR TEXT BLOCKS 30$: .IF NDF XFTN TYPMSG ENDP1M ;END OF PASS1 MSG .IFTF RETURN ENDP2X: JMP ENDP2 .ENDC .IF DF XFTN .SBTTL OUTPUT THE BLOCK SUMMARY BLKPRT: TST LINKSL ;ANY LISTING? BEQ 10$ ;NO .WRITE #LINKSL,#BLKTTL ;PUT OUT THE TITLE INC LINCT CALL PAG ;CHECK FOR END OF PAGE CLR ROLUPD ;GET READY FOR SEARCH 1$: NEXT SECROL ;GET AN ITEM BEQ 10$ ;QUIT WHEN DONE MOV #SYMBOL,R2 TST (R2)+ ;IS THIS THE PROGRAM NAME? BNE 2$ ;NO TST (R2) ;CHECK AV) ;END OF LINE FOUND? BNE ZLX ;NO, KEEP LOOKING BR ZLEQLX ;YES, GO AWAY .END ����������������������������������������; ; GENERATE STATEMENT LABEL FOR EXECUTABLE STATEMENT ; GENLAB: TST INHLAB ;IS THE LABEL NEEDED OR DESIRED? BNE LABEZ ;NOT AT ALL MOV R3,-(SP) MOV R4,-(SP) MOV #LINENO,R4 ;GET ADDRESS OF LINE NUMBER TSTB @R4 ;IS THERE A LINE NUMBER BEQ LABEX ;NO JSR R5,OUTCH2 ;OUTPUT A . '. JSR R5,OUTLN2 ;AND A LINE NUMBER LINENO MOV #TERM,R4 ;GET TERMINATOR LABEY: JWDECIMAL NUMBER? BGT GET604 ;NO INC R4 ;ADVANCE CHARACTER COUNT TRAP+130. ;DON'T LIKE DECIMAL IN OCTAL FIELD BR GET603 GET604: DEC R1 ;BACK UP THE POINTER TST R4 ;OCTAL FIELD NULL?? BNE GETN2 ;NO TRAP+132. ;NO GOOD IF ZERO LENGTH BR GETN2 ;CONTINUE WITH INTEGER OVF: TRAP+131. ;OCTAL CONSTANT TOO BIG MOV #-1,R3 ;MAKE A BIG NUMBER BR GETN2 ;AND CONTINUE GET27X: CLR T2(SP) ;HANDLE SPECIAL CASE BR GET27 ;E OR D CONSTANT ���������������������������������������� GET351: MXOBL EQVH1,EQVH2,EQVCLS,EQVCOM .GLOBL LOCADB,BLKNAM,COMHED,EQVHED .END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������YGAIN BNE 2$ ;AGAIN, NO MOVB #'*,BLTB ;SET PROGRAM FLAG MOV PRGTTL+2,(R2) ;STORE THE MOV PRGTTL,-(R2) ;PROGRAM NAME 2$: MOV #BLNAM,R2 ;CONVERT R50UNP ;TO ASCII MOVB #' ,(R2) ;SET UP THE BLANK CORRECTLY MOV #SYMBOL+10,R1 ;GET MOV #BLLGT1,R2 ;THE CALL SETWRD ;OCTAL LENGTH MOVB #'),(R2) ;RESTORE CLOBBERED PAREN MOV #BLLGT,R2 ;CLEAR MOV #6,R3 ;THE 5$: MOVB #' ,(R2)+ ;TEXT DEC R3 ;BUFFER BNE 5$ MOV SYMBOL+10,R1 ;GET CLC ;THE ROR R1 ;LENGTH MOV #BLLGT,R2 ;IN DNC ZSR PC,OUTLN1 ;OUTPUT IT MOV SEQNO,R3 JSR PC,OUTOCT JSR PC,EOL MOV (SP)+,R4 MOV (SP)+,R3 LABEZ: RTS PC TERM: .ASCII /: $SEQ,/ .BYTE 0 .EVEN LABEX: MOV #TERM+1,R4 BR LABEY ; ; HDRGEN - HEADER GENERATOR AND PROTOTYPES. UPON ENTRY ; R0 POINTS TO HEADER NAME. ; REGISTERS CHANGED - R1,R4,R5. ; HDRGEN: INC HDR ;SET HEADER GENERATED FLAG JSR R5,OUTLN2 ;OUTPUT THE NAME HDR1 SUB #SYM1WD,R0 JSR PC,OUTST JSR PC,EOL MOV #HEAD,R4 MOV #HLGT,R5 JSR PC,OUTLN MOV #HDR2,R4 ;OUTPU[OV 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 JMP GET35 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������] MOVB #' ,(R2) ;WORDS HERE AND RESTORE THE BLANK CMPB BLNAM,#'. ;IS THIS THE . ABS. SECTOR? BNE 3$ ;NO CMPB BLNAM+1,#'$ ;IS IT A COMMON BLOCK? BNE 1$ ;NO, IT IS THE ABS SECTION 3$: .WRITE #LINKSL,#BUFBLK ;WRITE THE DESCRIPTOR .WAIT #LINKSL ;WAIT FOR COMPLETION JSR PC,PAG MOVB #' ,R1 ;WE NEED SOME BLANKS HERE MOV #BLLGT,R2 ;GET ADDRESS OF SPACE TO CLEAR 4$: MOVB R1,(R2)+ ;BLANK A FRAME CMP R2,#BLLGT-1 ;DONE? BLO 4$ ;NO MOVB R1,BLTB ;BLANK PROGRAM MARKER BR 1$ 10$: RETURN ^T THE MOV #HDR2L,R5 ;REMAINDER JSR PC,OUTLN ;OF HEADER TST BLKDAT ;BLOCK DATA? BNE HDRE1 ;YES, SKIP REST OF FORMALITIES!! JSR R5,OUTLN2 HDR3 JSR PC,OUTST ;NAME JSR PC,EOL JSR PC,OUTST ;NAME AGAIN JSR R5,OUTLN2 HDR5 ADD #SYM1WD,R0 MOV (R0)+,R3 ;GET FIRST WORD OF NAME JSR PC,OUTOCT ;OUTPUT IT JSR R5,OUTCH2 ', MOV (R0)+,R3 ;OUTPUT JSR PC,OUTOCT ;SECOND WORD JSR PC,EOL HDRE1: RTS PC ; ; GENERATE STATEMENT LABEL FOR EXECUTABLE STATEMENT ; GENLAB: TST INHLAB ;IS THE_������������������������������������ GET36: TRAP+15. ;OVERFLOW ON INTEGER CONVERSION MOV #077777,R3 JMP GET361 ; ; GT222A: JMP GET222 ;INTERMEDIATE HELP GET33X: JMP GET33 ; ; ; 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` .TITLE TABSY .IDENT /0610/; DK,RG,LP ; ;COPYRIGHT 1971,1972,1973 DIGITAL EQUIPMENT CORP. ; ; ; PDP-11 FORTRAN IV, DOS-11 IMPLEMENTATION ; MONITOR-DEPENDENT IMPURE STORAGE AREA ; .NLIST BEX .GLOBL SRCEXT,LSTEXT,OBJEXT,BUFIN .GLOBL LINKI,LINKSL,LINKOL .GLOBL SRCIN,SRCLS,OBJLS,BUFOUT,BUFOBJ .GLOBL INHD,OUTHD,COMHD,OUTCNT,COMCNT .GLOBL CODE,CODECT,DIAG,DIAGCT,DBUF,GBUF .GLOBL CMDBUF,LINKK,LSTBLK,OBJBLK,INPBLK .GLOBL HEAD,HEAD1,HLGT,HLGT1 .GLOBL SRCERR,ISW .GLOBL VER1,VER2 .IF Na .NLIST BEX BLKTTL: .WORD 30. .WORD 0 .WORD 30. .BYTE 15,12 .ASCII / BLOCK LENGTH/ .BYTE 15,12 .EVEN BUFBLK: .WORD 27. .WORD 0 .WORD 27. .ASCII / / BLNAM: .ASCII /XXXXXX / BLLGT: .ASCII / (/ BLLGT1: .ASCII /000000)/ BLTB: .BYTE ' +.-. .BYTE 15,12 .EVEN .LIST BEX .ENDC .SBTTL OBJECT CODE HANDLERS ENDP2: ;END OF PASS 2 TST BLKTYP ;ANY OBJECT OUTPUT? BEQ 1$ ; NO CALL OBJDMP ;YES, DUMP IT MOV #BLKT06,BLKTYP ;SET END CALL RLDDMP ;DUMPb LABEL NEEDED OR DESIRED? BNE LABEZ ;NOT AT ALL MOV R3,-(SP) MOV R4,-(SP) MOV #LINENO,R4 ;GET ADDRESS OF LINE NUMBER TSTB @R4 ;IS THERE A LINE NUMBER BEQ LABEX ;NO JSR R5,OUTCH2 ;OUTPUT A . '. JSR R5,OUTLN2 ;AND A LINE NUMBER LINENO MOV #TERM,R4 ;GET TERMINATOR LABEY: JSR PC,OUTLN1 ;OUTPUT IT MOV SEQNO,R3 JSR PC,OUTOCT JSR PC,EOL MOV (SP)+,R4 MOV (SP)+,R3 LABEZ: RTS PC TERM: .ASCII /: $SEQ,/ .BYTE 0 .EVEN LABEX: MOV #TERM+1,R4 BR LABEY ; ; HDRGEN - HEADER GENc MOV (SP)+,R3 MOV (SP)+,R1 ;ELSE CONST. IS FLOATING 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. ANdDF COM8K .GLOBL LSW,OSW .ENDC .PSECT ZZZHGH ���������������������������������������� .SBTTL LISTING HEADERS ; ; FORTRAN HEADER ; HEAD: .ASCII /; / HEAD1: .ASCII /FORTRAN / VER1: .ASCII /......../ ;8 BYTES FOR VERSION NUMBER .BYTE 15,12 HLGT = .-HEAD HLGT1 = .-HEAD1 .IF NDF COM8K .GLOBL TITL,PNUM,TLGT,PAGNUM,LINCT,DTE,TIM,FORMCH TITL: .BYTE 15 FORMCH: .BYTE 15+.-. .ASCII /FORTRAN / VER2: .ASCII /......../ ;8 BYTES FOR VERSION NUMBER .ASCII / / TIM: .ASCII /00:00:00 / DTEe IT 1$: .IF NDF XFTN TST LOUTF ;ANY LISTING OUTPUT? BEQ 6$ ; NO BIT #LC.SYM,LCMASK ;SYMBOL TABLE SUPPRESSION? BNE 6$ ; YES CLR LINCNT ;FORCE NEW PAGE .IFF CMP LSTVAL,#3 BNE 6$ MOV #60.,LINCT ;ADVANCE JSR PC,PAG ;THE PAGE .ENDC CLR ROLUPD ;SET FOR SYMBOL TABLE SCAN 2$: MOV #LINBUF,R2 ;POINT TO STORAGE 3$: NEXT SYMROL ;GET THE NEXT SYMBOL BEQ 5$ ; NO MORE R50UNP ;UNPACK THE SYMBOL MOV #ENDP2T,R3 CALL ENDP2B CALL ENDP2B MOV #VALUE,R1 CALL SETWRD CALL fERATOR AND PROTOTYPES. UPON ENTRY ; R0 POINTS TO HEADER NAME. ; REGISTERS CHANGED - R1,R4,R5. ; HDRGEN: INC HDR ;SET HEADER GENERATED FLAG JSR R5,OUTLN2 ;OUTPUT THE NAME HDR1 SUB #SYM1WD,R0 JSR PC,OUTST JSR PC,EOL MOV #HEAD,R4 MOV #HLGT,R5 JSR PC,OUTLN MOV #HDR2,R4 ;OUTPUT THE MOV #HDR2L,R5 ;REMAINDER JSR PC,OUTLN ;OF HEADER TST BLKDAT ;BLOCK DATA? BNE HDRE1 ;YES, SKIP REST OF FORMALITIES!! JSR R5,OUTLN2 HDR3 JSR PC,OUTST ;NAME JSR PC,EOL JSR PC,OUTST ;NAME AGAIg 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 GET33X ;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 ;COMPUTE # DIGITS IN EXPONENT MOV R4h: .ASCII /00-XXX-70 PAGE / PNUM: .ASCII /0000/ .BYTE 15,12,12 TLGT=.-TITL .EVEN PAGNUM: 0 LINCT: 60.+.-. .ENDC .EVEN ���������������������������������������� .SBTTL LINK BLOCKS ; ; COMMAND INPUT LINK BLOCK AND OTHER JUNK ; 0 ;ERROR RETURN LINKK: 0 ;DDB LINK .RAD50 /CMI/ ;"FCM" PACKED RADIX 50 1 .RAD50 /KB/ ;"KB" IS DEVICE LSTBLK: CMDBUF LINKSL SRCLS OBJBLK: CMDBUF LINKOL OBJLS INPBLK: CMDBUF LINKI SRCIN ; COMMAND OUTPUT LINK BLOCK .GLOBL LINKL 0 LINKL: 0 iENDP2B CALL ENDP2B CMPB #1,-(R1) BGE 10$ CALL SETBYT 10$: MOVB #TAB,(R2)+ ;SEPARATOR CMP R2,#LINBUF+50. ;ENOUGH FOR ONE LINE? BLO 3$ ; NO 4$: CLRB -(R2) ;YES, CLEAR LAST TAB LSTLIN LINBUF ;OUTPUT LINE BR 2$ ;NEXT LINE 5$: CLRB (R2) LSTLIN LINBUF 6$: RETURN ENDP2B: MOV (R3)+,R0 BIT (R3)+,MODE BNE 1$ SWAB R0 1$: MOVB R0,(R2)+ RETURN ENDP2T: .ASCII / =/ .WORD LBLFLG .ASCII /% / .WORD REGFLG .ASCII /R / .WORD RELFLG .ASCII /G / .WORD GLBFLG GSDDMP:jN JSR R5,OUTLN2 HDR5 ADD #SYM1WD,R0 MOV (R0)+,R3 ;GET FIRST WORD OF NAME JSR PC,OUTOCT ;OUTPUT IT JSR R5,OUTCH2 ', MOV (R0)+,R3 ;OUTPUT JSR PC,OUTOCT ;SECOND WORD JSR PC,EOL HDRE1: RTS PC �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������k,T5(SP) SUB R5,R4 BNE GET32 ;IS THERE AN EXPONENT?? TRAP+23. ;NO, TELL USER OF ERROR GET32: 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 TST (SP) ;IS THE BNE 1$ ;RESULT TST 2(SP) ;EQUAL TO BNE 1$ ;ZERO?? CMP 4(SP),#1 ;IF SO, IS THE WIDTH = 1? BNE l.RAD50 /CMO/ 1 .RAD50 /KB/ ; ; SOURCE INPUT LINK BLOCK ; 0 ;ERROR RETURN ADDRESS LINKI: 0 ;DDB LINK .RAD50 /I1/ ;PRIMARY INPUT 11. ;DEVICE SPECIFIED .RAD50 /SY/ ;IS SYSTEM DEVICE ISW: 0,0,0,0,0,0 ;INPUT SWITCH SPACE (ROOM FOR 5 SW) 0,0,0,0 0 ;SWITCH LIST TERMINATOR <= 0 ����������������������������������������; ; SOURCE LIST LINK BLOCK ; 0 ;ERROR RETURN ADDRESS LINKSL: 0 ;DDB LINK .RAD50 /LST/ ;LISTING DEVICE .IF NDF COM8K 4 ;DEVICE SPECIFIED .IFF 1 .IFTF .m ;DUMP A GSD BLOCK CMP R2,#RLDBUF+RLDLEN-10 ;ROOM FOR ANOTHER? BLOS 1$ ; YES CALL PCRDMP ;NO, DUMP CURRENT 1$: JMP XMIT4 ;MOVE FOUR WORDS PCROLL: ;PROCESS CODE ROLL NEXT CODROL ;GET NEXT CODE ROLL ENTRY BEQ 21$ ; END CLR R5 ;ASSUME BYTE MOVB SECTOR,R4 ;GET THE RLD TYPE BMI 1$ ;BRANCH IF BYTE INC R5 ; WORD, BUMP TO 1 1$: TST PASS ;PASS ONE? BEQ 20$ ; YES, JUST UPDATE PC SETPF0 ;LIST COLUMN ZERO CLR R0 ASL R4 ;BYTE? ADC R0 ;MAKE ONE FOR BYTE ASL R0 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������o1$ ;WITH TST 6(SP) ;NO DECIMAL PART. BNE 1$ ;IF SO, TRAP+133. ;TELL HIM THAT A DOT ISN'T LEGAL ;AS A REAL VARIABLE 1$: 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 GET302: 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 THISpRAD50 /SY/ ;IS SYSTEM DEVICE .IFT LSW: 0,0,0 ;LIST SWITCH (ROOM FOR 1 SWITCH AND VALUE) .IFTF ; ; OBJECT OUTPUT LINK BLOCK ; 0 ;ERROR RETURN ADDRESS LINKOL: 0 ;DDB LINK .RAD50 /O1/ ;PRIMARY OUTPUT .IFT 3 ;DEVICE SPECIFIED .IFF 1 .IFTF .RAD50 /SY/ ;IS SYSTEM DEVICE .IFT OSW: 0,0 ;OBJECT SWITCH (ROOM FOR ONE SWITCH) ; ; ; ASSEMBLER LINK BLOCK ; .GLOBL LINKAS 0 LINKAS: 0 ;DDB LINK .RAD50 /ASM/ 1 .RAD50 /SY/ ;ASSEMBLER I/O OCCURS ON SYSTEM DEVICE ; ; ASSEMBLER Fq;NOW TWO CALL SETPFB ;LIST PROPER ITEM TST BLKTYP ;ANY OBJECT CODE CALLED FOR? BEQ 20$ ; NO BIC #177400,R4 ;YES, CLEAR HIGH ORDER BITS MOV PCRTBL(R4),R4 ;GET PROPER TABLE ENTRY MOV RLDPNT,R2 ;SET POINTER TO RLD BUFFER CMPB CLCSEC,OBJSEC ;SECTOR CHANGE? BEQ 11$ ; NO CMP R2,#RLDBUF+RLDLEN-10 ;ROOM IN CURRENT RLD? BLOS 41$ ; YES CALL PCRDMP ;YES, DUMP CURRENT BUFFERS 41$: MOV #RLDT07,(R2)+ ;SET RLD TYPE 7 MOV CLCNAM,(R2)+ ; AND NEW SECTOR NAME MOV CLCNAM+2,(R2)+ MOVB CLr .TITLE VERSON .GLOBL VERSON VERSON: .ASCII /V06.13 / .END ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������s 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 TYPE 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 T1tILE NAME BLOCK ; .GLOBL ASMMOD,ASMLS 0 ASMMOD: 2+.-. ;MODE GETS CHANGED ASMLS: .RAD50 /FOR/ .RAD50 /TRN/ .RAD50 /TMP/ 0 0 .IFTF ; ;DIAGNOSTIC FILE LINK BLOCK ; .GLOBL DGBLK 0 DGBLK: .BLKW .RAD50 /DGN/ 1 .RAD50 /SY/ .ENDC ����������������������������������������; ; SOURCE INPUT FILE NAME BLOCK ; SRCERR: 0 ;ERROR RETURN ADDRESS 4 ;OPEN FOR INPUT SRCIN: 23752 ;FILE NAME 77736 ;IS SRCEXT: 74623 ;FORTRN.SRC 0 ;UIC 0 ;P ; ; SOURCE LIST FILE NAME BLOCK ;uCSEC,OBJSEC BR 12$ 11$: CMP CLCLOC,OBJLOC ;DID PC MOVE ON US? BEQ 14$ ; NO CMP R2,#RLDBUF+RLDLEN-4 ;ROOM IN CURRENT RLD BUFFER? BLOS 42$ ; YES CALL PCRDMP ;YES, DUMP CURRENT BUFFER 42$: MOV #RLDT10,(R2)+ 12$: MOV CLCLOC,(R2)+ ;SET NEW PC 13$: CALL PCRDMP ;DUMP BUFFER 14$: MOV OBJPNT,R0 ;GET CODE POINTER ADD R5,R0 ;COMPUTE NEW END CMP R0,#OBJBUF+OBJLEN-1 ;ROOM? BHI 13$ ; NO MOVB R4,R0 ;YES, GET RLD SIZE ADD R2,R0 CMP R0,#RLDBUF+RLDLEN BHI 13$ ; NO ROOM, DUMP BUFFER��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������w5(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 (SP)+,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 JMP GET311 ; ;SPECIALIZED CODE x .GLOBL LSTER LSTER: 0 ;ERROR RETURN ADDRESS 2 ;OPEN FOR OUTPUT SRCLS: 23752 ;FILE 77736 ;NAME IS LSTEXT: 47014 ;FORTRN.LST 0 ;UIC 0 ;P ; ; OBJECT OUTPUT FILE NAME BLOCK ; .GLOBL OBJER OBJER: 0 ;ERROR RETURN ADDRESS 2 ;OPEN FOR OUTPUT OBJLS: 23752 ;FILE NAME 77736 ;IS OBJEXT: 57032 ;FORTRN.OBJ 0 ;UIC 0 ;P ���������������������������������������� .SBTTL RECORD BUFFERS ; ; OUTPUT WORKING BUFFER ; BUFOBJ: .BYTE '; ;HEADER BYTE BUFOUT: ;MAIN BUFFER . = .+y MOV OBJPNT,R1 CMP R1,#OBJBUF ;FIRST ITEM? BNE 44$ ; NO MOV #BLKT03,(R1)+ ;YES, SET BLOCK TYPE MOV CLCLOC,(R1)+ ; AND STARTING ADDRESS 44$: ASL R4 ;ANY RLD? BCC 15$ ; NO MOVB SECTOR,(R2)+ ;YES, SET CODE MOV R1,R0 SUB #OBJBUF,R0 ;COMPUTE INDEX MOVB R0,(R2)+ 15$: ASL R4 ;ANY SYMBOL REQUESTED? BCC 16$ ; NO MOV SYMBOL,(R2)+ ;YES, MOVE IT MOV SYMBOL+2,(R2)+ 16$: ASL R4 ;ANY VALUE? BCC 17$ ; NO MOV VALUE,(R2)+ ;YES, MOVE IT 17$: MOV R2,RLDPNT ;SAVE POINTER MOVB z160FORCOM.DGN 000I REDUNDANT CONTINUATION MARK; IT IS IGNORED 001I CONTINUATION MARK NOT IN RANGE 1 TO 9; IT IS IGNORED 002I ILLEGAL STMT. NUMBER, NON-NUMERIC CHAR. IN COLS. 1-5 003W ILLEGAL TYPE OR IMPLICIT STATEMENT, INTEGER IS ASSUMED. 004W NON-DECLARATIVE STATEMENT IN BLOCK DATA. 005F SYMBOL TABLE FULL. 006W TOO MANY CONTINUATION LINES, REMAINDER IGNORED. 007S MIXED MODE IS USED IN AN EXPRESSION. 008F ILLEGAL UNARY OP., ONLY +, -, OR .NOT. ARE ALLOWED. 009F CLOSING "/" MISSING ON BLOCK NAME.{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,LENWD(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. ; .GLOBL GETRTR GETRTR: MOV SERWD(R2),R0 ;GET SERIAL NUMBER OF ITEM BIC #SERMK,R0 CLR R3 ;ASSUME SIMPLE VARIABLE FOR NOW BIT #ENTYM|120 ;80 CHAR LONG BUFFER .GLOBL CHRBUF,CHREND,CHRLG,CHRPNT ; ; I/O BUFFER FOR NORMAL OPERATIONS ; CHRBUF: . = .+60. CHREND = . CHRLG = CHREND-CHRBUF .EVEN CHRPNT: CHRBUF ;CURRENT POINTER TO BUFFER ; ; DIAGNOSTIC AND CODE BUFFER ; DCHAR: .BYTE '; DBUF: . = .+120 ;80 CHARS LONG .EVEN CMDBUF: 0,0,0,0,0,0,0 ;COMMAND INTERPRETER HEADER ����������������������������������������; ; INPUT BUFFER ; INHD: 80. ;CONTAINS NO MORE THAN 80 BYTES 0 ;FORMATTED ASCII INPUT 0 ;BYTE COUN}VALUE,(R1)+ TST R5 BEQ 19$ ;BRANCH IF BYTE INSTRUCTION MOVB VALUE+1,(R1)+ 19$: MOV R1,OBJPNT 20$: INC R5 ;MAKE COUNT 1 OR 2 ADD R5,CLCLOC ;UPDATE PC MOV CLCLOC,OBJLOC ;SET SEQUENCE BREAK SETNZ R0 ;SET TRUE RETURN 21$: RETURN PCRDMP: MOV R2,RLDPNT ;SET RLD POINTER CALL OBJDMP MOV RLDPNT,R2 RETURN PCRTBL: ;TABLE BY RLD TYPE .WORD 0 .WORD 120004 ;RLDT01 .WORD 140006 ;RLDT02 .WORD 120004 ;RLDT03 .WORD 140006 ;RLDT04 .WORD 160010 ;RLDT05 .WORD 160010 ;RLD~ 010W ALL PORTIONS OF FORMAT MUST BE WITHIN OUTER LEVEL PARENS. 011W TOO MANY RIGHT PARENTHESES IN FORMAT. 012W ILLEGAL CHARACTER(S) TERMINATING A STATEMENT. 013F ILLEGAL FORM FOR A NUMERIC CONSTANT. 014F INSUFFICIENT COMPILER SPACE TO EVALUATE THIS CONSTANT. 015W INTEGER CONSTANT TOO BIG. LARGEST POS. VALUE ASSUMED. 016F ILLEGAL SYNTAX IN LIST ITEM. 017F ILLEGAL LIST TERMINATION. 018W ILLEGAL CHARACTER IN FORMAT STATEMENT. 019F DIMENSIONS MUST BE SPECIFIED FOR EACH VAR. IN THE LIST. 020F DIMSM,ENTYWD(R2) ; IS IT AN FUNCTION? BNE GETR04 ;YES BIT #CONMKM,CONWD(R2) ;IS CONSTANT BIT ON? BNE GETR02 ;BR IF YES BIT #DIMMKM,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 ;SHIFTT TRANSFERRED BUFIN: ;INPUT BUFFER PROPER . = .+120 ;80 CHARS LONG ; ; OUTPUT BUFFER HEADERS ; OUTHD: 100. ;100 BYTES LONG 4 ;DUMP ASCII MODE OUTCNT: 0 ;COUNT FOR OUTPUT BUFOUT ;POINTS TO BUFFER ; SAME AS ABOVE WITH ";" PRECEDING LINE COMHD: 101. ;ONE BYTE LONGER 4 ;DUMP ASCII MODE COMCNT: 0 ;BYTE COUNT BUFOBJ ; ; CODE GENERATION BUFFER HEADER ; CODE: 80. ;80 BYTES LONG 4 ;DUMP ASCII MODE CODECT: 0 ;OUTPUT COUNT DBUF ;BUFFER POINTER ; ; OBJECT DIAGNOST06 .WORD 0 .WORD 0 .WORD 100000 ;RLDT11 .WORD 0 .WORD 0 .WORD 0 .WORD 160010 ;RLDT15 .WORD 160010 ;RLDT16 OBJDMP: ;DUMP THE OBJECT BUFFER MOV #OBJHDR+2,R0 MOV #1,(R0)+ ;FORMATTED BINARY MOV OBJPNT,(R0) BEQ OBJINX ;EXIT IF NULL (NOT INITTED) SUB #OBJBUF,(R0) ;COMPUTE SIZE BEQ 1$ ; BRANCH IF EMPTY .IF NDF X11SIM NOP .IFF BR 9$ .ENDC .IF NDF XFTN .WRITE #OBJLNK,#OBJHDR .WAIT #OBJLNK .IFF .WRITE #LINKOL,#OBJHDR .WAIT #LINKOL .ENDC 9$: 1$: CMP R. CONFLICT WITH THOSE OF AN EARLIER STATEMENT. 021W UNRECOGNIZED STATEMENT. 022F ADJUSTABLE ARRAY NAME OR INDEX NOT A SUBPROGRAM PARAMETER. 023W MISSING EXPONENT IN CONSTANT. 024F MAXIMUM FUNCTION DEPTH (20) EXCEEDED. 025F MISMATCHED PARENTHESIS. 026F NON-ARRAY REFERENCE TO ARRAY ITEM. 027F CANNOT ASSIGN TO A CONSTANT. 028F CANNOT ASSIGN TO A FUNCTION. 029W ILLEGAL CHAR. TERMINATING A STMT. OR POSS. BAD OPERATOR. 030F SUBSCRIPT ON NON-ARRAY VARIABLE. 031W NAME MUST BE 1-6 ALPHANUMERICS, THE FI INTO LOW ORDER OF R2 SWAB R2 ASR R2 ASR R2 ASR R2 RTS PC ;RETURN ����������������������������������������; ;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 ENTRYTIC BUFFER HEADER ; DIAG: 81. ;81 BYTES LONG 4 ;DUMP ASCII MODE DIAGCT: 0 ;BYTE COUNT DCHAR ;BUFFER POINTER ; ; GENERAL PURPOSE DUMP ASCII MODE HEADER ; GBUF: 80. ;80 BYTES LONG 4 ;DUMP ASCII MODE 0 ;BYTE COUNT 0 ;BUFFER LINK ���������������������������������������� .SBTTL FREE STORAGE POINTERS ; DATA STORAGE CONTROL AREA - THE FOLLOWING POINTERS POINT TO ; THE VARIOUS ITEMSIN THE USER DATA AREA .GLOBL SRCLIN,SRCLEG,LINCNT,MTOP,FRHIGH .GLOBL FRLOW,OLDHGH,OLDLOWLDPNT,#RLDBUF+2 ;ANYTHING IN RLD? BLOS OBJINI ; NO, JUST INIT RLDDMP: MOV #RLDBUF,R0 MOV BLKTYP,(R0) MOV RLDPNT,-(R0) SUB #RLDBUF,(R0) MOV #1,-(R0) .IF NDF X11SIM NOP .IFF BR 9$ .ENDC .IF NDF XFTN .WRITE #OBJLNK,#RLDHDR .WAIT #OBJLNK .IFF .WRITE #LINKOL,#RLDHDR .WAIT #LINKOL .ENDC 9$: OBJINI: MOV #OBJBUF,OBJPNT MOV #RLDBUF+2,RLDPNT OBJINX: RETURN .CSECT IMPURE OBJPNT: .BLKW RLDPNT: .BLKW BLKTYP: .BLKW .CSECT .SBTTL LISTING OUTPUT .IF NDF XFTN RST ALPHABETIC. 032F ILL. SUBSCRIPT IN AN ARRAY ASSIGNMENT OR MISSING SUBSCRIPT. 033F ILLEGAL OPERAND OR POSSIBLE ADJACENT OPERATORS. 034F TOO MANY SUBSCRIPTS OR NO CLOSING PAREN FOR SUBSCRIPT. 035F NO FUNCTION ARGUMENTS PRESENT. 036F UNRECOGNIZABLE PARAMETER IN FUNCTION CALL. 037F FUNCTION CALL MISSING A ")". 038F ILLEGAL ROUTINE NAME. 039W MISSING END STATEMENT, END IS ASSUMED. 040W IMPROPERLY NESTED DO STATEMENT. 041W DO LIST OVERFLOW, NO MORE THAN 10 NESTED DO'S ARE ALLOWED. 042W ILLEGAL SY (IF ONE EXISTED) ; Z=1 IF THERE WAS AN ENTRY. ;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) ;LOO,STKBAS .GLOBL SYMBAS,SYMEND,SYMNXT,SYMCUR SRCLIN: .BLKW ;ADDRESS OF TEXT BUFFER SRCLEG: .BLKW ;LENGTH OF TEXT BUFFER LINCNT: 5+.-. ;NUMBER OF CONTINUATION LINES TO SET UP MTOP: .BLKW ;TOP OF MONITOR FRHIGH: .BLKW ;HIGHEST FREE CORE ADDRESS FRLOW: .BLKW ;LOWEST FREE CORE ADDRESS OLDHGH: .BLKW ;POINTER TO PREVIOUS HIGH ADDRESS STKBAS: ;EQUIVALENT TO OLDLOW OLDLOW: .BLKW ;POINTER TO ORIGINAL LOW ADDRESS ; SYMBAS: .BLKW ;START OF SYMBOL TABLE SYMEND: .BLKW ;ADDRESS OF LAST WORD OFTYPMSG: ;TYPE A MESSAGE MOV #1,LOUTR ;SET TO KB MODE .IFTF LSTLIN: ;LIST A LINE MOV R1,-(SP) ;SAVE TWO REGS MOV R2,-(SP) .IFT ASRB LOUTW ;WAITING ON KB? BCC 1$ ; NO .WAIT #CODLNK ;YES 1$: .IFF ASRB LOUTW+1 ;DITTO FOR LP BCC 2$ .IFT .WAIT #LSTLNK .IFF .WAIT #LINKSL .IFTF 2$: MOV (R5)+,R1 ;FETCH ARGUMENT MOV #LSTBUF,R2 ;SET DESTINATION INDEX 3$: MOVB (R1)+,(R2)+ ;XFER BNE 3$ ;TERMINATE ON NULL MOV #LSTBUF-2,R1 CLR (R1)+ ;SET MARKER TSTB -(R2) ;MOVENTAX IN COMMON/EQUIVALENCE. 043W TABLE OVERFLOW IN COMMON/EQUIVALENCE. 044W DUMMY VARIABLE OR ADJUSTABLE ARRAY USED IN COMMON. 045W VARIABLE ALREADY IN COMMON, CANNOT BE RE-DEFINED. 046F ILLEGAL DO STATEMENT SYNTAX. 047F DO CONTROL VARIABLE IS NOT A SIMPLE INTEGER VARIABLE. 048F DO PARAMETER IS NOT A SIMPLE INTEGER VARIABLE OR CONSTANT. 049W BAD STEP VALUE IN DO, IT IS ASSUMED TO BE 1. 050W ILLEGAL CONSTANT IN PAUSE/STOP. 051W ILLEGAL OR MISSING STATEMENT LABEL, IT MUST BE NUMERIC. 052F ILLEGAL K AT 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 RETURN ����������������������������������������; ; FREE SPACE SYMNXT: ;ALTERNATE NAME FOR SYMCUR SYMCUR: .BLKW ;START OF FREE SPACE ; .EVEN .END �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� BACK TO NULL 4$: CMPB #SPACE,-(R2) ;TRIM TRAILING SPACES BEQ 4$ CMPB #TAB,(R2) ; AND TABS BEQ 4$ TSTB (R2)+ ;MOVE TO FIRST BLANK MOVB #CR,(R2)+ ;STUFF CR MOVB #LF,(R2)+ ;SET LF SUB R1,R2 ;COMPUTE CHARACTER COUNT MOV R2,-(R1) ;SET COUNT CLR -(R1) ;CLEAR MODE .IFT TSTB LOUTR+1 ;LISTING REQUESTED? BEQ 11$ ; NO DEC LINCNT ;TIME FOR HEADER? BGE 10$ ; NO CALL HEADER ;YES, DUMP IT .IFF JSR PC,PAG .IFTF 10$: .IFT .WRITE #LSTLNK,#LSTHDR ;YES, WRITE IT .IFF  SYNTAX IN GOTO/ASSIGN STATEMENT. 053W ILLEGAL PARAMETER IN STATEMENT FUNCTION LIST. 054F ROUTINE NAME CANNOT BE A NUMERIC CONSTANT. 055W "SUBROUTINE" OR "FUNCTION" NOT FIRST STMT. OF ROUTINE. 056W ILLEGAL PARAMETER IN SUBROUTINE OR FUNCTION LIST. 057W TOO MANY PARAMETERS (>255) IN ROUTINE LIST. 058W CONSTANT MAY NOT BE DECLARED IN EXTERNAL. 059W TOO MANY LEFT PARENTHESES IN FORMAT. 060W MISSING COMMA OR ) IN COMMON/EQUIVALENCE. 061W MISSING ( IN COMMON/EQUIVALENCE. 062W DUMMY ARGUMENT OR ADJUSTMOVE 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 - - R1 POINTS TO TERMINATING CH OFITEM ;CURSYM POINTS TO SYMB TBL ENTRY FOR ITEM ;LOGIC - - IF ALL OF THE FOLLOWING CONDITIO��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������TST LINKSL ;ANY SOURCE LISTING? BEQ 12$ .WRITE #LINKSL,#LSTHDR .IFTF INCB LOUTW+1 ;SET WAIT FLAG .IFT TSTB LOUTF+1 ;LISTING DEVICE SAME AS LPT? BMI 12$ ; YES, DON'T DUPLICATE TSTB LOUTR ;KB REQUESTED? BEQ 12$ ; NO .WAIT #LSTLNK ;AVOID TIMING ERRORS 11$: .WRITE #CODLNK,#LSTHDR ;WRITE IT INCB LOUTW ;SET WAIT FLAG .IFTF 12$: MOV (SP)+,R2 ;RESTORE REGS MOV (SP)+,R1 RTS R5 ;RETURN PAST ARG .ENDC .CSECT IMPURE LOUTF: .BLKB 2 ;LISTING FLAGS LOUTR: .BLKB 2 ;LISABLE ARRAY USED IN EQUIVALENCE. 063W INCONSISTENT EQUIVALENCE. 064F TWO OR MORE COMMON ITEMS ARE EQUIVALENCED. 065F I/O UNIT IS NOT SIMPLE INTEGER VARIABLE OR CONSTANT. 066F ARRAY OR FUNCTION NAME NOT ALLOWED AS UNIT IN I/O STMT. 067F ILLEGAL SYNTAX IN I/O OR ENCODE/DECODE. 068F MISSING ARGUMENT IN FIND. 069F ILLEGAL RECORD DESIGNATOR IN RANDOM ACCESS READ/WRITE. 070F MISSING RIGHT PARENTHESIS IN I/O OR ENCODE/DECODE. 071W ILLEGAL FORM FOR END= AND/OR ERR= . 072W ILLEGAL FORM FOR LIST ITEM. 073NS 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 ; ; AN ALTERNATE CRITERION WHICH IS USED BY EXTERNAL IS IF ; IT IS AN UNDIMENSIONED PARAMETER WITH A LEFT PAREN ; FOLLOWING THE VARIABLE NAME. ; ; ;V=1 => THIS VARIABLE SHOULD BE DECLARED TO BE A FUNCTION NAMEC FORTRAN SYSTEM DIAGNOSTIC MESSAGE FILE BUILDER C THIS PROGRAM CAN BE USED TO BUILD FILES FOR C EITHER DOS-11 OR RSX-11D AND IT CAN BE C RUN UNDER EITHER SYSTEM BY MAKING THE APPROPRIATE C CHOICE OF "ASSIGN" OR "SETFIL" BELOW C C CREATES AND THEN PRINTS A FILE OF MESSAGES C FOR ACCESS BY THE FORTRAN COMPILER OR OTS C INPUT: C FILE - AS SPECIFIED BY KEYBOARD TYPE-IN C LUN - 4 C 1ST RECORD-- I3,40A1 I3=#OF 64 CHARACTER MESSAGES C TO BE ALLOCATED. 40A1=FILE SPECIFICATION C OTHER RECOTING REQUEST LOUTW: .BLKB 2 ;LISTING WAIT FLAGS ERRCNT: .BLKW ;ERROR COUNT .CSECT .IF NDF XFTN HEADER: ;HEADER ROUTINE MOV TTLSAV,R2 ;POINT TO PAGE NUMBER INC PAGNUM ;BUMP THE PAGE NUMBER MOV PAGNUM,R1 DNC ;CONVERT TO DECIMAL MOV #10$,R1 MOVBYT MOV #TTLBUF,R1 SUB R1,R2 ;COMPUTE LENGTH MOV R2,-(R1) CLR -(R1) .WRITE #LSTLNK,#TTLHDR ;LIST IT MOV #LPP,LINCNT ;SET NEW LINE COUNT RETURN 10$: .ASCIZ <CR><LF><LF> .EVEN SETHDR: ;INIT THE HEADER BUFFER MOV #TTF ILLEGAL SYNTAX FOR REWIND, BACKSPACE OR ENDFILE. 074F NON-INTEGER PARAMETER IN REWIND, BACKSPACE, OR ENDFILE. 075W ILLEGAL H CONSTANT IN FORMAT. 076W HOLLERITH CONSTANT COUNT TOO BIG. 077W SYNTAX ERROR IN IMPLICIT STATEMENT. 078W HOLLERITH CONSTANT IMPROPERLY TERMINATED BY END OF LINE. 079W .NOT. MAY BE USED AS A UNARY OPERATOR ONLY. 080W EXPONENT MAY NOT BE LOGICAL*1, LOGICAL*2 OR COMPLEX. 081W INTEGER**REAL OR INTEGER**COMPLEX NOT ALLOWED. 082W COMPLEX**REAL OR COMPLEX**DOUBLE NOT ALLOWED. 0 ;V=0 => THIS VARIABLE SHOULD LEFT AS IT NOW IS ; GEFUN: TSTB GETSW BEQ GEFUN1 ;BR IF NOT AN EXECUTABLE STATEMENT BIT #DIMMKM,DIMWD(R2) ;ANY DIMENSIONING BITS ON? BNE GEFUN1 ;JUMP IF DIMENSIONED BIT #PARMKM,PARWD(R2) ;IS IT A PARAMETER? BNE GEF01 ;YES GO CHECK FOR LEFT PAREN BIT #SGLMKM,SGLWD(R2) ;BR IF ITEM WAS REFERRED ;TO PREVIOUSLY BEQ GEFUN1 BIT #EXPMKM,EXPWD(R2) BEQ GEFUN1 ;BR IF ITEM NOT EXPLICITLY TYPED GEF01: JSR PC,CNXC ;GET NEXT NON BLANK CH. CMPB (R1),#'( BNE GEFRDS- I3,64A1 I3=POSITION OF CURRENT C MESSAGE IN THIS FILE. 64A1=CURRENT MESSAGE C LAST RECORD-- I3,64A1 I3=NEGATIVE INTEGER. 64A1=IGNORED C OUTPUT: C FILE - FILE SPECIFICATION READ INTO FILSPC C LUN - 1 C 64 CHARACTER FIXED LENGTH RECORDS C C LUN - 5 (NORMALLY LP:) C PRINTED OUTPUT C INTEGER COUNT,INDEX BYTE TODAY(9),FILSPC(40),A(64),NULL(64) DATA NULL / 64 * 0 / COUNT=0 WRITE (6,1000) 1000 FORMAT('$SPECIFY INPUT FILE>') READ(6,10001) I0,FILSPC 10001 FORMAT(Q,4LBUF,R2 ;POINT TO START MOV #10$,R1 MOVBYT ;MOVE TITLE IN MOV #HELLO+2,R1 MOVBYT ;DITTO FOR VERSION # .DATE ;GET THE DATE SUB #3720,(SP) ;CHEAT A BIT BMI 1$ CMP (SP),#366. BLE 2$ 1$: MOV #367.,(SP) 2$: MOV #11$,R1 ;POINT TO DAYS/MONTH TABLE 3$: SUB (R1)+,(SP) BGT 3$ ADD -(R1),(SP) MOV 12$-11$(R1),SYMBOL CLR SYMBOL+2 MOV (SP)+,R1 DNC MOVB #'-,(R2)+ R50UNP SUB #3,R2 MOV #13$,R1 MOVBYT MOV R2,TTLSAV RETURN 10$: .ASCIZ <FF>/.MAIN./<TAB> .EVEN 11$: .W83F IMPROPER LABEL SYNTAX IN IF STATEMENT. 084W ANYTHING **COMPLEX NOT ALLOWED. 085F MISSING COMMA IN READ, PRINT, OR PUNCH. 086F INCORRECT SYNTAX IN DEFINE FILE STATEMENT. 087W ARRAY MAY NOT BE DECLARED AS EXTERNAL. 088F ARRAY IS TOO LARGE. 089F ILLEGAL ROUTINE NAME. 090F ILLEGAL DO SPECIFICATION IN I/O OR ENCODE/DECODE. 091F ILLEGAL LIST IN IMPLIED DO. 092F ILLEGAL FORMAT SPEC. IN I/O OR ENCODE/DECODE. 093W SYNTAX ERROR IN THE EXPRESSION OF AN ASF. 094W MISSING "," OR ")" IN ASF. 095W MISPLAUN1 ;BR IF NO "(" FOLLOWS BIC #ENTYMM,ENTYWD(R2) BIS #100000,ENTYWD(R2) ;SET FUNCTION BIT GEFUN1: BIC #SGLMKM,SGLWD(R2) ;CLEAR SINGLE OCCURENCE 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. ;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(R00A1) C C SET UP THE INPUT FILE NAME ASSIGNMENT C C CALL ASSIGN(4,FILSPC,I0) CALL SETFIL(4,FILSPC,IERR,'SY',0) C ENDFILE 6 C C READ FIRST RECORD AND ALLOCATE CONTIGUOUS FILE READ(4,1001) IBLOK,FILSPC 1001 FORMAT(I3,40A1) C C SET UP THE OUTPUT FILE NAME ASSIGNMENT C C CALL ASSIGN(1,FILSPC,40) CALL SETFIL(1,FILSPC,IERR,'SY',0) C DEFINE FILE 1(IBLOK, 32, U, INDEX) C C INITIALIZE ALL RECORDS OF OUTPUT FILE TO ZEROS DO 10 I=1,IBLOK 10 WRITE (1'I)NULL C C READ INPUT AND WRITE EACH RORD 31., 29., 31., 30., 31., 30 .WORD 31., 31., 30., 31., 30., 31., 100. 12$: .RAD50 /JANFEBMARAPRMAYJUN/ .RAD50 /JULAUGSEPOCTNOVDECXXX/ 13$: .ASCIZ /-72 PAGE / .EVEN .ENDC .CSECT IMPURE TTLSAV: .BLKW TTLHDR: .BLKW 3 TTLBUF: .BLKW 82./2 TTLASC= TTLBUF+1 .CSECT DNC: ;DECIMAL NUMBER CONVERSION MOV #10.,R3 ;SET DIVISOR DIV ;DO SO MOV R1,-(SP) ;SAVE REMAINDER MOV R0,R1 ;SET FOR NEXT DIVIDE BEQ 1$ ; UNLESS ZERO CALL DNC ;RECURSE 1$: MOV (SP)+,R1 ;RETRIEVE NUMBER CED "=" IN ASF. 096F ASF NAME HAS BEEN PREVIOUSLY USED. 097W SUBSCRIPTS OUT OF BOUNDS IN DATA OR EQUIVALENCE. 098F ILLEGAL EXTENSION OF COMMON ORIGIN BY EQUIVALENCE. 099F OPENING "/" MISSING FROM DATA GROUP. 100W UNEQUAL NUMBER OF VARIABLES AND CONSTANTS. 101W DATA NOT ALLOWED IN COMMON EXCEPT IN "BLOCKDATA". 102F SUBSCRIPTS ON UNDIMENSIONED ELEMENT IN DATA. 103F ADJUSTABLE ARRAY NOT ALLOWED IN DATA. 104F PRESETTING NAMED COMMON ALLOWED ONLY IN "BLOCKDATA". 105F ILLEGAL FORM FOR CONSTANT IN DATA) ;IS THERE 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?? BLO PUTS05 ;YES, IT FITS JSR PC,GETMEM ;NO, TRY TO GET MORE STORAGE BVC PUTS05 ;GOT IT! MOV 2(SP),R1 ;DIE TRAP+5. ;SINCE THERE MOV STKBAS,SP ;IS NO MORE JMP SCANNR ;STORAGE AECORD OF OUTPUT FILE 40 READ (4,1002,END=50)I0,I1,A 1002 FORMAT(Q,I3,64A1) IF (I1 .LT. 0) GO TO 50 COUNT=COUNT+1 C I0=I0-3 IF (I0 .LE. 0) GO TO 40 IF (I0 .LT. 64)A(I0+1)=0 C I1=I1+1 WRITE (1'I1)A GOTO 40 C C READ THE CONTIGUOUS FILE AND C PRINT A LISTING OF THE COMPLETED FILE 50 ENDFILE 4 CALL DATE(TODAY) WRITE (5,1003) FILSPC, TODAY 1003 FORMAT(1H1,28X,40A1/1H0,'MSG MESSAGE',17X,9A1/' NUM'/) C DO 51 I1=1,IBLOK READ(1'I1)A I2=I1-1 51 WRITE (5,1004) I2,A 1004 FORMAT(X,ADD #'0,R1 ;CONVERT TO ASCII MOVB R1,(R2)+ ;STORE CLRB (R2) RETURN R50UNP: ;RAD 50 UNPACK ROUTINE MOV R4,-(SP) ;SAVE REG MOV #SYMBOL,R4 ;POINT TO SYMBOL STORAGE 1$: MOV (R4)+,R1 ;GET NEXT WORD MOV #50*50,R3 ;SET DIVISOR CALL R50UNX ;DIVIDE AND STUFF IT MOV #50,R3 CALL R50UNX ;AGAIN FOR NEXT MOV R1,R0 CALL R50UNY ;FINISH LAST GUY CMP R4,#SYMBOL+4 ;THROUGH? BNE 1$ ; NO MOV (SP)+,R4 ;YES, RESTORE REGISTER RETURN R50UNX: DIV R50UNY: TST R0 ;SPACE? BEQ 3$ . 106F ILLEGAL REPEAT COUNT. 107W MISMATCHED DATA TYPES. 108W DATA MUST FOLLOW ALL OTHER DECLARATIVES. 109I NO PATH TO THIS STATEMENT. 110W VARIABLE MAY NOT HAVE BEEN REDEFINED AFTER USE IN "ASSIGN". 111F ILLEGAL FORM FOR COMPLEX CONSTANT. 112W NUMBER OF DIMENSIONS NOT THE SAME AS DECLARED. 113W RETURN IS ILLEGAL IN MAIN PROGRAM. 114W MISSING DO LOOP TERMINATION(S). 115F DIMENS. NOT TERM. BY RIGHT PAREN OR TOO MANY DIMENSIONS. 116W ROUTINE NAME CANNOT BE DECLARED EXTERNAL. 117F ENCODE/DECODE LVAILABLE PUTS05: MOV SYMNXT,R4 ;GET ADDRESS OF DESTINATION MOV R0,R3 ;GET ADDRESS OF SOURCE MOV (SP)+,R5 ;AND COUNT JSR PC,MOVE ;MOVE THE BASIC 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) I3,X,64A1) WRITE (5,1005) IBLOK,COUNT 1005 FORMAT(/X,I3,' MESSAGES ALLOCATED.',I6,' MESSAGES INPUT.') ENDFILE 1 ENDFILE 5 END ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������; YES CMP R0,#33 ;TEST MIDDLE BLT 2$ ;ALPHA BEQ 1$ ;DOLLAR ADD #22-11,R0 ;DOT OR DOLLAR 1$: ADD #11-100,R0 2$: ADD #100-40,R0 3$: ADD #40,R0 MOVB R0,(R2)+ ;STUFF IT CLRB (R2) RETURN .SBTTL I/O BUFFERS .IF NDF XFTN SRCCSI: .WORD CMDBUF, SRCLNK, SRCFIL .IFTF .CSECT IMPURE .IFT .BLKW 1 SRCLNK: .BLKW 4 .IFTF SRCHDR: .BLKW 3 SRCBUF: .BLKW SRCLEN/2 .IFT .BLKW 2 SRCFIL: .BLKW 4 SRCNAM: .BLKW ;DEFAULT OUTPUT NAME .IFTF .CSECT .IFT LSTCSI: .WORACKS LEGAL BUFFER DESCRIPTOR. 118F ENCODE/DECODE BUFFER SIZE NOT SIMPLE INTEGER. 119F ARRAY OR FUNCTION CANNOT DESCRIBE BUFFER SIZE. 120S VARIABLE USED BUT NOT PREVIOUSLY DEFINED. 121F DIAGNOSTIC TABLE OVERFLOW. 122F ILLEGAL FORM FOR UNIT NUMBER IN DEFINE FILE. 123F MISSING "(" IN DEFINE FILE. 124F ILLEGAL RECORD COUNT (M) IN DEFINE FILE. 125F ILLEGAL RECORD LENGTH (L) IN DEFINE FILE. 126F DEFINE FILE ONLY ALLOWS UNFORMATTED (U) MODE. 127F DEFINE FILE ASSOCIATED VARIABLE NOT SIMPLE INTEGER. 128;STORE THE POINTER TO THE NEXT PUTS03: MOV SYMNXT,R1 ;SET MOV R1,CURSYM ; UP MOV R1,LSTCHN ; CURSYM AND LSTCHN MOV R4,SYMNXT ;NOW RESET THE END POINTER BIS #SGLMKM,SGLWD(R1) ;SET "SINGLE OCCURRENCE" MOV (SP)+,R1 ;RESTORE R1 RTS PC ; ; ; 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) ; ; OUTPUT - V=0, ENTRY FOUND ; V=1, NO ENT��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������D CMDBUF, LSTLNK, LSTFIL .RAD50 /LST/ OBJCSI: .WORD CMDBUF, OBJLNK, OBJFIL .RAD50 /OBJ/ .IFTF .CSECT IMPURE .IFT .BLKW 1 LSTLNK: .BLKW 4 .IFTF LSTHDR: .BLKW 3 LSTBUF: .BLKW LSTLEN/2 .IFT .BLKW 2 LSTFIL: .BLKW 4 .BLKW 1 OBJLNK: .BLKW 4 .IFTF OBJHDR: .BLKW 3 OBJBUF: .BLKW OBJLEN/2 .IFT .BLKW 2 OBJFIL: .BLKW 4 .IFTF OCTBUF: .BLKW OCTLEN/2 LINBUF: .BLKW LINLEN/2 LINEND: .BLKW 1 RLDHDR: .BLKW 3 RLDBUF: .BLKW RLDLEN/2 .CSECT .ENDC .SBTTLW MISSING ")" IN DEFINE FILE. 129F EXPRESSION STACK OVERFLOW 130W ILLEGAL FORM FOR OCTAL CONSTANT. 131W OCTAL CONSTANT TOO LARGE. 132W OCTAL CONSTANT MUST HAVE AT LEAST ONE CHARACTER. 133W IMPROPER FORM FOR REAL CONSTANT. 134I NO EXECUTABLE STATEMENTS IN A MAIN PROGRAM. 135W MISSING COMMA. 136W REDUNDANT COMMA. 137W IMPLICIT STATEMENT APPEARS AFTER STATEMENT IT AFFECTS. 138W LOGICAL OP. MEANINGFUL ONLY ON BYTE, LOGICAL, OR INTEGER. 139F EQUIVALENCE GROUP TOO LARGE FOR ADDRESS SPACE. 140W ATTEMRY FOUND ; CURSYM=ADDRESS OF FOUND ENTRY ; R2, R3 = SAME AS SERATR .GLOBL SYMCON ; 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, NORMAL RETURN ; V=1, SYSTEM ERROR, ENTRY SERATR: BIC #170000,R0 MOV R1,-(SP)DIRECTORY DT1: [��� 1,�����1 ] 28-SEP-73 MACFTN.MAC 150 28-SEP-73 <���233> 046763 MSSIO .MAC 5 28-SEP-73 <���233> 064451 OPTTAB.MAC 5 28-SEP-73 <���233> 107441 OUTSL .MAC 4 28-SEP-73 <���233> 002251 OVLAY .MAC 10 28-SEP-73 <���233> 177327 PATCH .MAC 2 28-SEP-73 <���233> 021037 PARSE .MAC 35 28-SEP-73 <���233> 103342 PSTFTN.MAC 17 28-SEP-73 <���233> 155144 RDCI .MAC 16 28-SEP-73 <���233> 073301 RUNLNK.MAC 6 28-SEP-73 <���233> 003313 S EXPRESSION EVALUATOR EXPR: ;EXPRESSION EVALUATION SAVREG ;SAVE REGISTERS TERM ;TRY FOR A TERM BEQ 5$ ;EXIT IF NULL CLR -(SP) ;NON-NULL, SET REGISTER FLAG STORAGE 1$: BIS FLAGS,(SP) ;SAVE REGISTER FLAG MOV #BOPTBL,R1 ;SET TO SCAN BINARY OPERATOR TABLE 2$: CMP (R1)+,R5 ;MATCH? BEQ 10$ ; YES, FOUND A BINARY OP TST (R1)+ ;NO, MOVE PAST ADDRESS BNE 2$ ;LOOP IF NOT DONE BIC #-1-REGFLG,(SP) ;FINISHED, MASK ALL BUT REGISTER FLAG ASR RELLVL ;TEST RELOCATON LEVEL BNE 3$ ;PTED EQUIVALENCE TO MISALIGNED BYTE ITEM. 141W ILLEGAL EXPRESSION MODE IN IF STATEMENT 142W DATA VALUE EXCEEDS BYTE MAGNITUDE 143F DELIMITER > MISSING FROM VARIABLE FORMAT EXPRESSION 144W EMPTY VARIABLE FORMAT EXPRESSION 145F VARIABLE FORMAT EXPRESSION NOT ALLOWED WITH H FORMAT 146W NEGATIVE OR ZERO CONSTANT AS SUBSCRIPT 147F INTERNAL ERROR DURING CODE GENERATION -01****TERMINATING LINE**** ����������������������������������������������������������������������������������������������������������� 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 SER07 SER06: MOV SERWD(R3),-(SP) BIC #SERMK,@SP CMP (SP)+,R0 ;CURRENT ITEM A HIT? SER07: BEQ SER03 ;PCLST.MAC 25 28-SEP-73 <���233> 110344 STOPAU.MAC 11 28-SEP-73 <���233> 053722 STRTUP.MAC 9 28-SEP-73 <���233> 051231 SUBFUN.MAC 7 28-SEP-73 <���233> 107633 UTILTY.MAC 39 28-SEP-73 <���233> 034215 SYMTAB.MAC 59 28-SEP-73 <���233> 037034 SYMBOL.MAC 8 28-SEP-73 <���233> 032501 TABF4 .MAC 20 28-SEP-73 <���233> 141471 TABSY .MAC 13 28-SEP-73 <���233> 136735 VERSON.MAC 2 28-SEP-73 <���233> 007102 COMDGN.SRC 15 28-SEP-73 <���233> 162725 FORDGBRANCH IF NOT 0 OR 1 BCC 4$ ;BRANCH IF 0 TST (SP) ;RELOCATABLE, TEST REGISTER FLAG BEQ 4$ ;BRANCH IF NOT SET ERROR R ;REL AND REG, ERROR BR 4$ 3$: ERROR A ;IMPROPER RELOCARION 4$: BIS (SP)+,FLAGS ;MERGE REGISTER BIT SETNZ R0 ;SET TRUE 5$: RETURN 10$: MOV (R1),-(SP) ;BINARY OPERATOR, STACK SUBROUTINE ADDR MOV #SYMBOL,R0 ;SET TO STACK CURRENT VALUE MOV (R0)+,-(SP) ;STACK MOV (R0)+,-(SP) ;STACK MOV (R0)+,-(SP) ;STACK MOV (R0)+,-(SP) ;STACK MOV (R0)+,-(SP) ;STACK GETNB ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������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 MOV (SP)+,R5 MOV (SP)+,R1 CLV RTS PC ; ;ROUTINE TO GET MORE MEMORY ALLOCATED FOR THE SYMBOL TABLE ; SPACE IS ALLOCATED IN 160. BYTE INCREMENTS AT ��N.FTN 6 28-SEP-73 <���233> 166614 FREE BLKS: 98 FREE FILES: 34 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ;BYPASS OP TERM ;EVALUATE NEXT TERN BNE 11$ ;BRANCH IF OK ERROR A ; NULL, ERROR 11$: MOV #SYMBOL,R3 ;SET POINTER TO SYMBOL MOV #VALUE,R4 MOV #TEMP+10.,R0 MOV (SP)+,-(R0) ;MOVE OLD TO TEMP MOV R0,R2 ;R2 POINTS TO RELLVL MOV (SP)+,-(R0) MOV R0,R1 ;R1 POINTS TO VALUE MOV (SP)+,-(R0) MOV (SP)+,-(R0) MOV (SP)+,-(R0) CMP #BOPABS,(SP) ;ABSOLUTE ONLY? BGT 12$ ; NO, CHECK IN LINE BIS -(R1),-(R4) ;YES, MERGE FLAGS CALL ABSTST ;TEST FOR ABSOLUTE CMP (R1)+,(R4)+ ;RESTORET UP NEXT MAP DSKB12: MOV LIM,R0 ;SET BITS FOR NONEXISTENT ;BLOCKS AND TRAN OUT SUB MINBK,R0 ;R0 HAS NO OF BLOCKS REPRESENTED ;IN FINAL BIT MAP MOV BTMPBF,R3 ADD #8.,R3 DSKB13: SUB #BPW,R0 ;DETERMINE WHICH BLOCKS BLO DSKB14 ;REPRESENTED WITHIN THIS TST (R3)+ ;MAP ARE NON-EXISTENT BR DSKB13 ;AND SET THOSE BITS DSKB14: MOV #-1,R5 DSKB15: ADD #BPW,R0 DEC R0 BMI DSKB16 ASL R5 BR DSKB15 DSKB16: MOV R5,(R3)+ MOV BTMPBF,R4 ADD #2*64.,R4 MOV #-1,R0 JSR PC,BFIN01 ;A TIME ; APPROXIMATELY 10 SYMBOLS WORTH. ; .GLOBL GETMEM,FRLOW GETMEM: MOV R0,-(SP) MOV R1,-(SP) MOV SYMEND,R0 ;GET CURRENT END POINTER MOV FRHIGH,R1 ;GET HIGHEST FREE ADDRESS SUB #20,R1 ;SUBTRACT FUDGE FACTOR CMP R0,R1 ;IS THERE ROOM CURRENTLY? BHIS 2$ ;ALREADY OVERFLOWED ADD #160.,R0 ;ADD 10 MORE SYMBOLS CMP R0,R1 BLOS 1$ MOV R1,SYMEND ;TAKE LESSER OF TWO EVILS BR 3$ 1$: MOV R0,SYMEND ;PLENTY OF ROOM LEFT 3$: ADD #2,R0 ;FRLOW CAN7T BE SAME AS SYMEND MOV R0,FRLOW ;REMEMBR FILNAM IN ERROR BUF CLR -(R6) MOVB 3(R3),@R6 MOV LBERNO,-(R6) BR LBSE00 LBOFER: MOV #2204,LBERNO JSR PC,NAMCLR BR LBSW07 LBIFER: ;INPUT FILE ERROR PROCESSOR MOV #2213,LBERNO ;INSERT CODE CLR R0 BR LBSW00 LBSMER: ;SEMANTIC ERROR PROCESSOR MOV #2203,LBERNO ;INSERT CODE BR LBSW00 LBSE00: MOV #CMEB,-(R6) INIT ;INIT ERROR DEVICE MOV #LXERBF,-(R6) ;SEND ERROR MESSAGE MOV #CMEB,-(R6) WRITE MOV #CMEB,-(R6) ;********************* WATE ;***************** REGISTERS 12$: CALL @(SP)+ ;CALL SUBROUTINE BR 1$ ;LOOP BOPTBL: ;BINARY OP TABLE .WORD '+, 2$ .WORD '-, 1$ .WORD '*, EXPMUL .WORD '/, EXPDIV .WORD '&, 10$ .WORD '!, 11$ .WORD -1, 0 1$: NEG (R4) ; -, NEGATE VALUE NEG RELLVL ; AND RELLVL MOV R0,-(SP) RELTST ;MAKE SURE NO GLOBALS MOV (SP)+,R0 2$: ADD (R1),(R4) ; +, ADD VALUES CMP -(R1),-(R4) ;POINT TO FLAGS ADD (R2),RELLVL ;ADD RELLVL'S BIT #GLBFLG!RELFLG,(R1) ;ABS * XXX? BEQ 3$ ; YES, ALL SET BIT #GLBFSET BITS FOR NON-EXISTENT ;BLOCKS JSR PC,INTRN ;TRAN FINAL BIT MAP TO DISK BPL DSKB17 ;ANY ERRORS ? JSR PC,RPACT ;YES, TAKE ACTION .SBTTL WRITE BADB.SYS TO THE DISK DSKB17: MOV BADBL,R0 ;SET UP FILE CONTROL BLOCKS SUB BADB,R0 ADD #2,R0 MOV R0,BADBHA MOV #BADBFB,R0 .OPENO #RPLKB,R0 ;NOW WRITE BADB.SYS TO THE DISK .WRITE #RPLKB,#BADBHB .WAIT #RPLKB .CLOSE #RPLKB .WRITE #TTYLB1,#CMPLBF ;YES, PRINT COMPLETION MESSAGE .WAIT #TTYLB1 ;AND WAIT .EXIT ;EXIT .SBTTL MARK ER LOW LIMIT OR CORE TOO MOV (SP)+,R1 MOV (SP)+,R0 RTS PC 2$: MOV (SP)+,R1 MOV (SP)+,R0 SEV ;SET FAILURE TO FIND STORAGE RTS PC ;AND RETURN ; ;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 ; �����������������������������������������������**** IOT LBERXT: ;ERROR EXIT TST OLLB ;OUTPUT LIBR DEVICE INITED? BEQ LBRX00 ;NO - BRANCH MOV #OLFB,-(R6) ;OUTPUT LIBRARY OPEN? MOV #OLLB,-(R6) DSRCH TST (R6)+ BIT #FILOPN,(R6)+ BEQ LBRXOL ;NO - BRANCH MOV #OLLB,-(R6) CLOSE ;DELETE OUTPUT LIBR MOV #OLFB,-(R6) ;AND RELEASE DEVICE MOV #OLLB,-(R6) DELETE LBRXOL: MOV #OLLB,-(R6) RELEASE LBRX00: TST ILLB ;INPUT LIBR DEVICE INITED? BEQ LBRX05 ;NO - BRANCH MOV #ILFB,-(R6) ;INPUT LIBRARY OPEN? MOV #ILLB,-(R6)LG!RELFLG,(R4) ;XXX * ABS? BEQ 4$ ; YES, OLD FLAGS BIT #GLBFLG,(R1) ;ERROR IF EITHER GLOBAL BNE 5$ BIT #GLBFLG,(R4) BNE 5$ CMPB 1(R4),1(R1) ;REL +- REL, SAME SECTOR? BNE 5$ ; NO, ERROR BIS #RELFLG,(R4) TST RELLVL BNE 3$ BIC #177400!RELFLG,(R4) 3$: RETURN 4$: MOV (R0)+,(R3)+ MOV (R0)+,(R3)+ BIS (R0)+,(R3)+ RETURN 5$: JMP ABSERR BOPABS= . ;START OF ABS RANGE 10$: COM (R1) BIC (R1),(R4) RETURN 11$: BIS (R1),(R4) BIS -(R1),-(R4) RETURN EXPMUL: ; *OPTION CONTROL ;INMARK READS AN ADDRESS AND/OR SWITCH FROM THE KB AND PROCESSES ; THE ADDRESS ACCORDING TO THE SWITCH. ; THE ADDRESS SPECIFIES EITHER A DISK BLOCK OR SECTOR. ; A SINGLE FIELD ADDRESS IS A BLOCK NO. AND A TRIPLE ; FIELD ADDRESS SEPARATED BY ':' ; IS A SECTOR NO. (CYLINDER:TRACK:SECTOR). ; THE SWITCH DETERMINES WHETHER THE ADDRESS IS TO BE ADDED ; TO OR DELETED FROM BADB.SYS; OR, IF NO MORE ADDRESSES ; FOLLOW. INMARK: 1$: .WRITE #TTYLB1,#MRKSGN ;'*' TO TTY CLR NBRTSK JSR P�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� DSRCH TST (R6)+ BIT #FILOPN,(R6)+ BEQ LBRXIL ;NO - BRANCH MOV #ILLB,-(R6) CLOSE ;CLOSE FILE AND LBRXIL: MOV #ILLB,-(R6) ;RELEASE DEVICE RELEASE LBRX05: TST IFLB ;INPUT FILE DEVICE INITED? BEQ LBRX10 ;NO - BRANCH MOV #IFFB,-(R6) ;INPUT FILE OPEN? MOV #IFLB,-(R6) DSRCH TST (R6)+ BIT #FILOPN,(R6)+ BEQ LBRXIF ;NO BRANCH MOV #IFLB,-(R6) ;CLOSE FILE AND CLOSE ;RELEASE DEVICE LBRXIF: MOV #ILLB,-(R6) RELEASE LBRX10: TST LLLB ;LISTING DEVICE INITED? BEQ LBRX15 ;NO MOV (R1),R0 ;FETCH FIRST ARG MOV R0,-(SP) ;SAVE A COPY BPL 1$ ;POSITIVE? NEG R0 ; NO, MAKE IT SO 1$: MOV (R4),R3 ;SET SECOND ARG BPL 2$ ;BRANCH IF POSITIVE NEG R3 ;NEGATIVE, MAKE IT + COM (SP) ;TOGGLE RESULT SIGN 2$: MUL ;MULTIPLY MOV R1,R0 ;SET FOR EXIT BR EXPDVX ;EXIT THROUGH DIVIDE EXPDIV: ; / MOV (R4),R3 ;SET DIVISOR MOV R3,-(SP) ;SAVE A COPY BPL 1$ ;BRANCH IF PLUS NEG R3 ;MAKE IT THUS 1$: MOV (R1),R1 ;SET QUOTIENT BPL 2$ ;AGAIN!!! NEG R1 COM C,KBINP ;READ INPUT - BAD BLOCK NO/SW JSR PC,ADDMRK ;EXTRACT BAD BLOCK NO BMI 2$ ;ADDRESS ERROR JSR PC,SWMRK ;EXTRACT SWITCHES BMI 2$ ;SWITCH ERROR BIT #ADDR,NBRTSK ;IS THIS A VALID BLOCK NO ? BEQ 4$ ;NO MOV R1,-(SP) ; MOV #TB,R1 ; MOV (SP)+,(R1) ;PREPARE BLOCK NO. FOR ;BADBI AND BADBU BIT #UN,NBRTSK ;MARK OPTION ? BNE 3$ ;NO, UNMARK JSR PC,BADBI ;YES BR 4$ 3$: JSR PC,BADBU ;UNMARK BLOCK NO FROM BADB 4$: BIT #LIST,NBRTSK ;LISTING REQUESTED ? BEQ 5$ ;NO JSR PC,LIST MOV #INDTA,R0 JSR PC,MODE ;READING UNFMTD BINARY? BR RC05 ;YES - BRANCH JSR PC,DATA ;ANYTHING TO OUTPUT? BEQ RC00 ;NO - BRANCH MOV CURBUF,R4 JSR PC,FDWRT ;WRITE OUT JSR PC,FLIP ;CHANGE OUTPUT BUFFERS BR RC00 ASCCNV: MOV #ASCBUF,R4 ;ASCII CONVERSION JSR PC,FDWRT MOV #INDTA,R0 AS00: JSR PC,FDIC ;INSERT LINE COUNTER AS05: DEC INBUF+4 ;ANY MORE DATA? BLT AS10 ;NO - BRANCH JSR PC,ASCII ;ENTER IN LINE BIT #1,R1 ;DONE TWO YET? BNE AS05 ;NO - BRANCH ADD #6,R1 ; - BRANCH MOV #LLFB,-(R6) ;LISTING FILE OPEN? MOV #LLLB,-(R6) DSRCH TST (R6)+ BIT #FILOPN,(R6)+ BEQ LBRXLF ;NO - BRANCH MOV #LLLB,-(R6) CLOSE MOV #LLFB,-(R6) ;DELETE FILE AND MOV #LLLB,-(R6) ;RELEASE DEVICE DELETE LBRXLF: MOV #LLLB,-(R6) RELEASE LBRX15: TST CMEB ;ERROR DEVICE INITED? BEQ LBRX20 ;WON'T BE ON RESTART MOV #CMEB,-(R6) RELEASE LBRX20: JMP LIB00 NAMCLR: MOV #LXERFL,R2 ;ROUTINE TO CLEAR FILE NAME BUFFER ;FOR ERROR REPORTING CLR (R2)+ CLR (R2)+ CLR(SP) 2$: DIV ;OPERATE EXPDVX: TST (SP)+ ;TEST RESULT BPL 1$ ; OK AS IS NEG R0 ;NO, NEGATE IT 1$: MOV R0,(R4) ;SET RESULT RETURN ;DIV R3,R0 (R0 IGNORED) ;MUL R3,R0 DIV: ;GENERAL DIVIDE ROUTINE MOV #16.,-(SP) ;LOOP COUNT CLR -(SP) ;RESULT CLR R0 ;IGNORE R0 INPUT 1$: ASL (SP) ;SHIFT RESULT ASL R1 ;SHIFT WORK REGISTERS ROL R0 ; DOUBLE REGISTER CMP R0,R3 ;BIG ENOUGH FOR OPERATION? BLT 2$ ; NO SUB R3,R0 ;YES INC (SP) ;BUMP RESULT 2$: DEC 2(SP) ;TBB ;YES 5$: BIT #DONE,NBRTSK ;DONE MARK OPTION ? BEQ 1$ ;GET NEXT BAD BLOCK NO/SW RTS PC ;RETURN 2$: .WRITE #TTYLB1,#INMRKE ;BAD BLOCK ADDRESS OR SW ERROR .WAIT #TTYLB1 BR 1$ ;GET NEXT BAD BLOCK NO/SW .SBTTL MARK OPTION ADDRESS ANALYSIS ;ADDMRK READS INPUT STRING UP TO FIRST TERMINATOR, LETTER OR '/' ; AND RETURNS WITH AN ADDRESS (BLOCK NO.) OR ERROR SWITCH. ; R0 POINTS TO THE CHARACTER ; R1 CONTAINS THE BLOCK NO. ADDMRK: MOV #RESDTA,R0 ;INITIALIZE INPUT STRING POINTER CMPB #'0,(UPDATE BUFFER POINTER JSR PC,LINFUL ;IS THE LINE FULL? BLO AS05 ;NO - BRANCH MOV CURBUF,R4 ;WRITE THE BUFFER JSR PC,FDWRT JSR PC,FLIPC ;CHANGE OUTPUT BUFFERS BR AS00 ;YES - BRANCH BR AS05 AS10: BITB #EOF,INBUF+3 BEQ AS15 ;BRANCH IF NOT EOF JMP OC20 AS15: JSR PC,FDRD ;READ SOME MORE INPUT MOV #INDTA,R0 JSR PC,MODE ;READING UNFMTED BINARY? BR AS05 ;YES - BRANCH JSR PC,DATA ;ANY DATA TO OUTPUT? BEQ AS00 ;NO - BRANCH MOV CURBUF,R4 JSR PC,FDWRT ;WRITE OUT JSR PC,FLIP (R2)+ CLR (R2)+ CLR (R2) RTS PC ; ***** DELETE OBJECT MODULES ***** LBDLOM: JSR PC,LBILIN ;INITIALIZE INPUT LIBR JSR PC,LBOLIN ;INITIALIZE OUTPUT LIBR LIBD00: MOV #ILLB+10,R4 LIBD05: MOV @R4,R5 ;MORE SWITCHES ON INPUT LIBR? BEQ LIBD25 ;NO - BRANCH ASL R5 ADD R5,R4 ;POINT AT SWITCH MOV R4,-(R6) ADD #2,@R6 ;SAVE POINTER TO NEXT ONE CMP #DELOM,@R4 ;IS IT /D? BEQ LIBD15 ;YES - BRANCH LIBD10: MOV (R6)+,R4 BR LIBD05 ;TRY NEXT ONE LIBD15: ASR R5 DEC R5 ;ANTEST FOR END BNE 1$ MOV R0,R1 ;PLACE REMAINDER IN R1 MOV (SP)+,R0 ;RESULT TO R0 DIVXIT: TST (SP)+ ;PRUNE STACK RETURN MUL: ;GENERAL MULTIPLY ROUTINE MOV R0,-(SP) ;GET THE FIRST GUY CLR R0 ;CLEAR RESULTS CLR R1 1$: TST (SP) ;THROUGH? BEQ DIVXIT ; YES ROR (SP) BCC 2$ ADD R3,R1 ADC R0 2$: ASL R3 BR 1$ ;SPECIAL ENTRY POINT TO EXPR ;NULL FIELD CAUSES ERROR ;R0 SET TO VALUE REGEXP: ;REGISTER EXPRESSION ABSEXP ;MUST BE ABSOLUTE REGTST: BIT #-10R0) ;IS CHAR AN OCTAL NO ? BHI 2$ ;NO, MAYBE A TERMINATOR CMPB #'7,(R0) ; BHIS 3$ ;YES, IT IS AN OCTAL NO. CMPB #':,(R0) ;IS IT ':' ? BNE 2$ ;NO 1$: SEN ;SYNTAX ERROR RTS PC ;ERROR RETURN 2$: CLN ;CLEAR ERROR FLAG RTS PC ;RETURN 3$: JSR PC,CVT ;CONVERT NO.TO BINARY CMPB #':,(R0) ;IS CHAR ':' ? BNE 4$ ;NO, CHECK FOR VALID BLOCK NO. INC R0 ;POINT TO NEXT CHAR CMPB #'0,(R0) ;IS CHAR AN OCTAL NO ? BHI 1$ ;NO, SYNTAX ERROR CMPB #'7,(R0) ; BLO 1$ ;NO, SYNTAX ERROR  ;CHANGE OUTPUT BUFFERS BR AS00 FDBLBF: ;BLANKS THE BUFFER CLR -(R6) MOV CURBUF,R3 ADD #6,R3 BLBF00: MOV #SPSP,(R3)+ ;MOVE IN TWO BLANKS INC @R6 CMP @R6,#36. ;DONE 72. BYTES YET? BLO BLBF00 ;NO - BRANCH TST (R6)+ RTS PC MODE: CMPB INBUF+2,#3 ;UNFORMATTED BINARY MODE? BEQ MODE00 ;YES - BRANCH ADD #2,@R6 ;BUMP CALLERS PC MODE00: RTS PC FDWRT: ;WRITES THE BUFFER CMP R4,CURBUF ;WRITING A PRIMARY OUTPUT? BNE FDWRT2 ;NO - BRANCH MOV #OUTSIZ,4(R4) ;RESET BY VALUES? BNE LIBD20 ;YES - BRANCH LIBD17: MOV #2,R0 ;SET INPUT LIBRARY CODE JMP LBSWER ;SWITCH ERROR LIBD20: JSR PC,LBPKOM ;PACK NAME OF OBJ MOD JSR PC,LIBDOM ;CALL DELETE OBJECT MODULE DEC R5 ;MORE OM'S TO DELETE? BNE LIBD20 ;YES - BRANCH BR LIBD10 LIBD25: TSTB LBPASS ;DONE YET? BNE LIBD40 ;YES - BRANCH LIBD30: JSR PC,LBDWRT ;FINISH WRITING DIRECTORY INCB LBPASS ;SET PASS TWO BR LIBD00 LIBD40: TSTB LBEOF BEQ LIBD45 CLRB LBEOF ;CLEAR EOF INDICATOR JMP LBEXIT ;GO TO ,VALUE ;3 BITS? BEQ REGERX ; YES, OK REGERR: ERROR R ;NO, ERROR REGERX: MOV #REGFLG,MODE BIC #-10,VALUE BR ABSERX GLBEXP: EXPR BEQ ABSERR BR ABSERX RELEXP: GLBEXP RELTST: BIT #GLBFLG,FLAGS BEQ ABSERX BR ABSERR ABSEXP: GLBEXP ABSTST: BIT #GLBFLG!RELFLG,FLAGS BEQ ABSERX ABSERR: ERROR A CLR MODE CLR VALUE CLR RELLVL ABSERX: MOV VALUE,R0 ;RETURN WITH VALUE IN R0 RETURN .SBTTL TERM EVALUATOR TERM: ;TERM EVALUATOR SAVREG INC EXPFLG MOV #MODE,R3 ;POIMOV R1,CYLNDR ;SAVE CYLINDER ADDRESS JSR PC,CVT ;CONVERT TRACK NO. TO BINARY CMPB #':,(R0)+ ;IS CHAR ':' ? BNE 1$ ;NO, SYNTAX ERROR CMPB #'0,(R0) ; BHI 1$ ;NO, SYNTAX ERROR CMPB #'7,(R0) BLO 1$ ;NO, SYNTAX ERROR MOV R1,TRACK ;SAVE TRACK ADDRESS JSR PC,CVT ;CONVERT SECTOR NO. TO BINARY MOV R1,SECTOR ;SAVE SECTOR ADDRESS CMPB #':,(R0) ;IS CHAR ':' ? BEQ 1$ ;YES, SYNTAX ERROR JSR PC,STBCVT ;NO, CONVERT SECTOR ADDRESS ;TO BLOCK ADDR 4$: CMP LIM,R1 ;IS BLOCK NO. OUT OF YTE COUNT MOV R4,R3 ;MOVE THE <CR><LF> ADD #OUTSIZ+4,R3 ;BACK TO THE END OF THE DATA FDWRT1: CMP #SPSP,-(R3) BNE FDWRT2 MOV #CRLF,@R3 BR FDWRT1 FDWRT2: MOV R4,-(R6) MOV #OUTLB,-(R6) WRITE ;WRITE AND WAIT INC R5 ;BUMP LINE COUNTER CMP R5,#PAGSIZ ;IS THIS THE END OF THE PAGE BNE FDWR05 ;NO - BRANCH FDWR00: MOV #PGCBUF,R4 ;WRITE A FORM FEED JSR PC,FDWRT MOV #HDRBUF,R4 ;WRITE NEXT PAGE HEADER JSR PC,FDWRT MOV #4,R5 FDWR05: RTS PC FDRD: ;READS NEXT INPUT MOV #INBUF,EXIT PROCESSOR LIBD45: JSR PC,LBNXTE ;FINISH WRITING OBJ MODULES BR LIBD40 ; ***** CREATES A LIBRARY ***** LBCRT: JSR PC,LBOLIN ;INITIALIZE OUTPUT LIBRARY LBCL00: TST IFLB+10 ;ANY SWITCHES ON INPUT FILE? BEQ LBCL02 ;NO - BRANCH CLR R0 ;SET INPUT FILE CODE JMP LBSMER ;SEMANTIC ERROR LBCL02: JSR PC,LBININ ;INITIALIZE INPUT FILE LBCL03: TSTB LBPASS ;PASS ONE? BNE LBCL05 ;NO - BRANCH JSR PC,LBCDIR ;CREATE DIRECTORY ENTRY BR LBCL10 LBCL05: JSR PC,LBCOM ;CREATE OBJ MODULENTER TO FLAGS MOV #VALUE,R4 ; AND VLAUE CLR (R3) CLR (R4) CLR RELLVL GETSYM ;TRY FOR A SYMBOL BEQ TERM20 ;BRANCH IF NOT A SYMBOL CMP SYMBOL,R50DOT ;LOCATION COUNTER? BEQ 6$ ; YES, TREAT SPECIAL SSRCH ;SEARCH THE SYMBOL TABLE BEQ 7$ ;BRANCH IF NOT FOUND BIT #MDFFLG,(R3) ;MULTIPLY DEFINED? BEQ 1$ ; NO ERROR M ; YES 1$: BIT #DEFFLG,(R3) ;DEFINED? BNE 2$ ; YES BIT #GLBFLG,(R3) ;NO, GLOBAL? BNE 4$ ; YES ERROR U ;NO, UNDEFINED ERROR 2$: BIC #GLBFLG,(R3) ;CLEBOUNDS ? BLOS 1$ ;YES, ERROR RETURN CMP #1,R1 ; BHIS 1$ ;YES, ERROR RETURN BIS #ADDR,NBRTSK ;SET VALID ADDRESS FLAG BR 2$ ;RETURN .SBTTL SECTOR TO BLOCK ADDRESS CONVERSION ; IF CYLINDER:TRACK:SECTOR FORMAT IS SPECIFIED BY ; MARK MODE COMMAND STRING, THIS ROUTINE IS ENTERED ; TO CONVERT THE INPUT TO BLOCK FORMAT. ; THIS ROUTINE IS FOR RP DISKS ONLY STBCVT: TST TASK ;IS DSK RP ? BMI 4$ ;YES, CONTINUE .WRITE #TTYLB1,#DEVRP ;NO, WRITE FAILURE MESSAGE .WAIT #TTYLB1 ;AND EX-(R6) MOV #INLB,-(R6) READ ;READ AND WAIT MOV #INLB,-(R6) WATE BITB #IOERR,INBUF+HDRSTA ;ANY DEVICE ERROR? BNE DVERR ;YES YELL RETURN ;NO PROBLEM DVERR: MOVB INBUF+HDRSTA,-(R6) ;STACK STATUS SERROR: MOV #S207,-(R6) ;STACK ERROR CODE JMP YELL ;AND SAY IT ;TRANR TRANS IN A BLOCK CHECKS FOR EOM OR DEVICE ERROR ;AND IF NONE OCCURS IT WILL RETURN TO CALLER ELSE THE ;USER WILL BE TOLD THE BLOCK NUMBER AND S207 ERROR TRANR: BIT #DVDTA,FILSTR ;IS DEVICE A DECTAPE BEQ NODTA ;NO S ENTRY LBCL10: JSR PC,LBINFL ;READ NEXT LINE OF INPUT FILE BITB #EOF,3(R3) ;EOF? BNE LBCL13 ;YES - BRANCH CMP #GSD,LBFDTA ;INPUT FILE ERROR IF FIRST BEQ LBCL03 ;LINE IS NOT A GSD LINE JMP LBIFER LBCL13: JSR PC,LBINRL ;GET NEXT INPUT FILE TST IFLB+6 ;IS THERE ONE? BNE LBCL00 ;YES - BRANCH TSTB LBPASS ;WAS THIS PASS TWO? BEQ LBCL15 ;NO - BRANCH JMP LBEXIT ;GO TO EXIT PROCESSOR LBCL15: INCB LBPASS ;SET PASS TWO MOV #LBFDTA,R3 MOV #EDIR,@R3 ;WRITE THE END DIR LINE MOV #2,-AR INTERNAL GLOBAL FLAG 3$: 4$: BIC #DEFFLG!LBLFLG!MDFFLG,(R3) ;CLEAR EXTRANEOUS BIT #RELFLG,(R3) BEQ 5$ INC RELLVL 5$: SETNZ R0 ;SET TRUE RETURN 6$: MOV #CLCNAM,R1 ;DOT, MOVE TO WORKING AREA MOV #SYMBOL,R2 CALL XMIT4 CLRB (R3) ;CLEAR FLAGS TST (R3) ;ABSOLUTE SECTION? BEQ 3$ ; NO BIS #RELFLG,(R3) ;YES, SET FLAG BR 3$ 7$: OSRCH ;NOT USER DEFINED, PERHAPS AN OP-CODE? TST (R3) ;MISSING OR DIRECTIVE? BPL 8$ ; YES CLR (R3) ;OK, CLEAR FLAGS BR 5$ ;USE BASIC VALIT .EXIT 4$: MOV R0,-(SP) ;SAVE R0 CMP DPSLIM,SECTOR ;IS SECTOR NO. WITHIN RANGE ? BLOS 10$ ;NO, SET ADDRESS ERROR MOV SECTOR,R1 ;YES, GET SECTOR TST TRACK ;IS TRACK NON-ZERO BEQ 2$ ;TRACK IS ZERO CMP DPTLIM,TRACK ;IS TRACK NO. WITHIN RANGE ? BLOS 10$ ;NO, SET ADDRESS ERROR MOV #10.,R0 ;YES 1$: ADD TRACK,R1 ;ADD 10*TRACK TO BLOCK NO. DEC R0 BGT 1$ 2$: TST CYLNDR ;IS CYLINDER ZERO BEQ 3$ ;YES MOV #200.,R0 ;ADD 200.*CYLNDR TO BLOCK NO. 6$: ADD CYLNDR,R1 BCC 7$ ;OVERPECIAL TST TRNBLK ;BLOCK IN REVERSE? BGE NODTA ;NO CLASSIC WAY NEG TRNBLK ;MAKE IT POSITIVE BIS #DTREV,TRNBLK+TRNSTS ;FLAG REVERSE NODTA: MOV #TRNBLK,-(R6) ;TRAN BLOCK ADDRESS MOV #INLB,-(R6) ;AND LINK BLOCK TRAN ;ARE STACKED FOR TRAN MOV #INLB,-(R6) ;NEXT WAIT WATE ;TO SEE THE STATUS BIC #DTREV,TRNBLK+TRNSTS ;AND UNDO REVERSE BIT #TRNEOM+TRNERR,TRNBLK+TRNSTS BNE TRNBAD ;TOO BAD RETURN TRNBAD: MOV TRNBLK,-(R6) ;STACK EVIDENCE BR SERROR ;AND SEEROR CODE FDIC: MOV(R3) CMP -(R3),-(R3) JSR PC,LBOTWR JSR PC,LBRST ;RESET INPUT AND OUTPUT PTRS JSR PC,LBIRL ;GET FIRST INPUT FILE SEMANTICS BR LBCL00 ; ***** INSERTS OR REPLACES OBJECT MODULES ***** LBRORI: JSR PC,LBILIN ;INITIALIZE INPUT LIBR JSR PC,LBOLIN ;INITIALIZE OUTPUT LIBR LBRI: MOV #1,R0 ;INITIALIZE POSITION POINTER LBRI00: JSR PC,LBININ ;INITIALIZE INPUT FILE LBRI03: MOV #IFLB+10,R4 MOV (R4)+,R5 ;ANY SWITCHES ON INPUT FILE? BNE LBRI05 ;YES - BRANCH CLR R0 ;SET INPUT FILE CUE 8$: SSRCH INSERT ;NOT IN TABLE, INSERT AS UNDEFINED ERROR U BR 3$ ;EXIT TERM20: MOV CRADIX,R2 ;ASSUME NUMBER, CURRENT RADIX 21$: CVTNUM ;CONVERT BEQ TERM40 ; NOPE, MISSED AGAIN BPL 22$ ;NUMBER, ANY OVERFLOW? ERROR T ; YES, FLAG IT 22$: CMP R5,#CH.DOT ;NUMBER, DECIMAL? BEQ 24$ ; YES CMP R5,#CH.DOL ;NO, LOCAL SYMBOL? BEQ 24$ ; YES TSTB R0 ;NO, ANY NUMBERS OUT OF RANGE? BEQ 27$ ; NO ERROR N ;YES, FLAG IT BR 27$ 24$: CMP R2,#10. ;"." OR "$", WERE WE FLOW ? BIT #CBIT,NBRTSK ;YES, ANY PREVIOUS OVERFLOW ? BEQ 9$ ;NO PREVIOUS OVERFLOW 10$: MOV #-1,R1 ;PREVIOUS OVERFLOW, SETUP FAILING EXIT BR 5$ 9$: BIS #CBIT,NBRTSK ;OVERFLOW, SET FLAG 7$: DEC R0 ;NO BGT 6$ 3$: CMP #256.,BSZW ;IS IT RP02 BEQ 5$ ;YES CLC BIT #CBIT,NBRTSK ;OVERFLOW ? BEQ 8$ ;NO, CONTINUE SEC ;YES, SET C 8$: ROR R1 5$: MOV (SP)+,R0 ;RESTORE R0 RTS PC .SBTTL MARK OPTION SWITCH ANALYSIS ; EXAMINE MARK OPTION COMMAND STRING SYNTAX ; AND VERIFY VALIDITY OF S CURBUF,R1 ;INSERTS COUNT ADD #6,R1 ;POSITION TO BEGINNING OF ;OUTPUT BUFFER MOV FDCOUNT,-(R6) MOV R1,-(R6) MOV #5,-(R6) UTILITY ADD #7,R1 ;SET UP FOR "E" FLAG MOV R1,R4 ;SAVE THIS ADDRESS BITB #FATER,INBUF+3 ;ANY ERRORS? BEQ FDIC00 ;NO - BRANCH JSR PC,MODE ;IN A FORMATTED MODE? BR FDIC00 ;NO - BRANCH MOVB #'E,@R1 ;INSERT ERROR FLAG FDIC00: TSTB (R1)+ ;BUMP BUFFER POINTER INC FDCOUNT ;AND COUNTER JSR PC,MODE ;IN UNFORMATTED MODE? BR FDIC10 ;YES - BRANCH MOODE JMP LBSMER ;SEMANTIC ERROR LBRI05: DEC R5 ;ANY VALUES? BNE LBRI10 ;YES - BRANCH CMP #RPLACE,@R4 ;IS IT /R? BEQ LBRI15 ;YES - BRANCH CMP #INSERT,@R4 ;IS IT /I? BNE LBRI30 ;NO - SWITCH ERROR MOV #-1,R4 ;NO VALUE MEANS INSERT AT END LBRI07: JSR PC,LIBIOM ;CALL INSERT MODULE BR LBRI20 LBRI10: TST (R4)+ CMP #INSERT,@R4 ;IS IT /I:V? BNE LBRI30 ;NO - SWITCH ERROR MOV -(R4),-(R6) MOV #2,-(R6) ;CONVERT DECIMAL ASCII TO UTILITY ;BINARY AND PLACE IN R4 MOV (R6)+,R4 ;IF ZERDECIMAL? BEQ 25$ ; YES SETSYM ;NO, MOV #10.,R2 ; TRY AGAIN WITH DECIMAL RADIX BR 21$ 25$: CMP R5,#CH.DOT ;DECIMAL? BEQ 26$ ; YES LSRCH ;NO, LOCAL SYMBOL BNE 26$ ;BRANCH IF FOUND ERROR U ; NO, FLAG AS UNDEFINED 26$: GETCHR ;BYPASS DOT OR DOLLAR 27$: SETNB ;BYPASS ANY TRAILING BLANKS SETNZ R0 RETURN TERM40: MOV #UOPTBL,R1 ;POINT TO UNARY OPS 41$: CMP (R1)+,R5 BEQ 42$ MOV (R1)+,R0 BNE 41$ RETURN 42$: CALL @(R1) SETNB SETNZ R0 RETURN UOPTBL:WITCHES SWMRK: 7$: CMPB #'/,(R0) ;IS CHAR '/' ? BEQ 2$ ;YES CMPB #'A,(R0) ;NO, IS CHAR A LETTER ? BLOS 1$ ;YES, ERROR RETURN CLN ;NO RTS PC ;RETURN 1$: SEN ;SET ERROR FLAG RTS PC ;RETURN 2$: INC R0 ;POINT TO NEXT CHAR CMPB #'/,(R0) ;IS CHAR '/' ? BEQ 1$ ;YES. ERROR CMPB #'M,(R0) ;MARK OPTION ? BNE 3$ ;NO BIC #UN,NBRTSK ;SET MARK OPTION SWITCH BR 5$ ;BUMP POINTER AND EXAMINE ;NEXT CHAR 3$: CMPB #'U,(R0) ;UNMARK OPTION ? BNE 4$ ;NO BIS #UN,NBRTSK ;SET UNMV #INBUF+3,R0 JSR PC,BYTES ;OUTPUT STATUS BYTE TST -(R0) ;POINTER MODE BYTE TSTB (R1)+ ;LEAVE A SPACE JSR PC,BYTES ;OUTPUT MODE BYTE CMPB (R1)+,(R0)+ ;LEAVE A SPACE ;AND POINTER THE BYTE COUNT WORD JSR PC,OCTAL ;OUTPUT THE BYTE COUNT WORD BITB #EOF,INBUF+3 ;EOF BIT SET? BNE FDIC06 ;YES, DON'T WRITE BYTE COUNT ;WE ARE NOW 34(8) BYTES FROM MOV R1,R4 ;THE HEAD OF THE BUFFER SUB #34,R4 ;POINT TO THE HEAD OF IT JSR PC,FDWRT ;WRITE THIS LINE FDIC06: JSR PC,FLIPA ;CHANGE BUFO, SET R4 = 1 BNE LBRI13 INC R4 LBRI13: TST (R6)+ BR LBRI07 LBRI15: JSR PC,LIBROM ;CALL REPLACE MODULES LBRI20: MOV #LBFLBF,R3 JSR PC,LBINFL ;READ NEXT INPUT LINE BITB #EOF,3(R3) ;END OF FILE? BNE LBRI23 ;YES - BRANCH CMP #GSD,LBFDTA ;INPUT FILE ERROR IF FIRST BEQ LBRI03 ;LINE IS NOT A GSD LINE JMP LBIFER LBRI23: JSR PC,LBINRL ;GET NEXT INPUT FILE TST IFLB+6 ;ANYTHING THERE? BNE LBRI00 ;YES - BRANCH TSTB LBPASS ;WAS THIS PASS TWO? BEQ LBRI25 ;NO - BRANCH JMP LIBD40 ; .WORD '+, 51$ .WORD '-, 50$ .WORD '', 53$ .WORD '", 52$ .WORD '%, 56$ .WORD '<, 60$ .WORD -1, 0 50$: CALL 51$ NEG (R4) JMP ABSTST 51$: GETNB TERM BEQ 55$ RETURN 52$: GETCHR MOVB R5,(R4)+ BEQ 55$ 53$: GETCHR MOVB R5,(R4)+ BEQ 55$ 54$: GETNB RETURN 55$: ERROR A RETURN 56$: CALL 51$ ABSTST BIS #REGFLG,(R3) RETURN NSTEXP= . ;NESTED EXPRESSION 60$: GETNB GLBEXP CMP R5,#CH.RAB ; ">" BEQ 54$ BR 55$ .SBTTL SYMBOL/CHARACTER HANDLERS ARK OPTION SWITCH BR 5$ ;BUMP PTR AND EXAMINE NEXT CHAR 4$: CMPB #'L,(R0) ;LISTING REQUESTED ? BNE 8$ ;NO BIS #LIST,NBRTSK ;YES, SET LIST OPTION SWITCH BR 5$ ;BUMP PTR AND EXAMINE NEXT CHAR 8$: CMPB #'D,(R0) ;DONE MARKING BAD BLOCKS ? BNE 1$ ;NO, ERROR RETURN BIS #DONE,NBRTSK ;YES SET DONE FLAG 5$: INC R0 ;BUMP POINTER 6$: CMPB #'A,(R0)+ ;IS CHAR A LETTER BLOS 6$ ;YES EXAMINE NEXT CHAR DEC R0 ;NO, BACK-UP 1 CHAR BR 7$ ;GET NEXT SWITCH .SBTTL VERIFY OPTION CONTROL ;DSKVER FERS RTS PC FDIC10: INC FDCOUNT ;SET UP FOR BYTE COUNT TSTB -(R4) ;BACK UP TO APPEND 0 MOVB #'0,@R4 RTS PC ;TWO BUFFERS ARE USED FOR PRINT OUTPUT, ;FLIPPING IS THE CHANGING FROM ONE BUFFER ;TO THE NEXT THERE ARE BASICALLY 3 CALLS: ; ;1. FLIP DO BASIC FLIP OPERATION ;2. FLIPA AS 1 , BUT IN ADDITION R1:=.CURBUF+STLIN ; (BLISS NOTATION!) ;3. FLIPC IF MODE IS UNFORMATTED BINARY THEN RETURN ; ELSE SET SKIP RETURN AND AS 2 FLIPC: CALL FLIP ;DO FLIP ACTION CALL MODE ;CHECK MODE EXIT THROUGH LBDLOM LBRI25: JSR PC,LBRST ;RESET I/O POINTERS MOV #LBSEM,-(R6) SEMANTICS ;GET PAST THE INPUT LIBR TST (R6)+ ;TO THE FIRST INPUT FILE JSR PC,LBIRL ;SET UP FIRST INPUT FILE JSR PC,LBDWRT ;FINISH WRITING DIRECTORY INCB LBPASS ;SET PASS TWO BR LBRI LBRI30: CLR R0 ;SET INPUT FILE CODE JMP LBSWER ; ***** LISTS THE DIRECTORY ***** LBLIST: TST LLLB+6 ;LISTING REQUESTED? BNE LBLST ;YES - BRANCH JMP LIB00 LBLST: TST OLLB+6 ;IF AN OUTPUT LIBRARY, LIST BEQGSARG: ;GET SYMBOLIC ARGUMENT TSTARG ;TEST FOR ARGUMENT BEQ GETSYX ; EXIT NULL IF NONE GETSYM: SAVREG MOV CHRPNT,SYMBEG ;SAVE IN CASE OF RESCAN MOV #SYMBOL+4,R1 CLR -(R1) CLR -(R1) MOV #26455,R2 SETR50 BLE 5$ CMP R0,#36 BGE 5$ 1$: CALL MULR50 2$: ASR R2 BCS 1$ ADD R0,(R1) 3$: GETR50 BLE 4$ ASR R2 BCS 2$ BEQ 3$ TST (R1)+ BR 1$ 4$: SETNB 5$: MOV SYMBOL,R0 GETSYX: RETURN MULR50: ;MULTIPLY R0 * 50 ASL R0 ASL R0 ASL R0 MOV R0,-(SP) ASLWRITES A TEST PATTERN TO THE DISK, READS BACK THE ; PATTERN, AND VERIFIES THAT IT WAS READ CORRECTLY. ; THIS IS DONE FOR THE ENTIRE DISK IF THE /VERIFY ; SWITCH IS SET; OTHERWISE, ONLY THE MINIMAL NUMBER ; OF BLOCKS REQUIRED FOR THE DOS/BATCH FILE STRUCTURE IS ; VERIFIED. THIS PROCEDURE IS REPEATED WITH A SECOND TEST ; PATTERN. IF /VERIFY WAS NOT SPECIFIED AND ANY ERRORS ; ARE ENCOUNTERED ON THE BLOCKS RESERVED FOR THE DOS/BATCH ; FILE STRUCTURE, THE PROGRAM WILL AUTOMATICALLY ; VERIFY THE ENT RETURN ;UNFORMATTED BINARY ADD #2,(R6) ;SET SKIP RETURN BR SETR1 ;SET R1 AS IN FLIPA FLIPA: CALL FLIP ;FLIP BUFFERS SETR1: MOV CURBUF,R1 ;BUT SET R1 PAST ADD #STLIN,R1 ;PAST HEADER RETURN FLIP: ;FLIPS THE OUTPUT BUFFERS CMP CURBUF,#OBUF1 BNE FLIP00 MOV #OBUF2,CURBUF BR FLIP05 FLIP00: MOV #OBUF1,CURBUF FLIP05: JSR PC,FDBLBF ;BLANK THE NEW BUFFER RTS PC DATA: ;CHECKS FOR OUTPUT DATA MOV CURBUF,R3 ADD #STLIN,R3 CMP R1,R3 RTS PC LINFUL: ;CHECKS FOR  LBLS05 ;IT, OTHERWISE LIST INP LIBR MOV #OLLB,-(R6) INIT MOV #OLLB,-(R6) STATUS ;CAN OUTPUT LIBR DEVICE BIT #INOK,(R6)+ ;SUPPORT INPUT? BNE LBLS00 ;YES - BRANCH MOV #2247,LBERNO ;SET LISTING ERROR JSR PC,NAMCLR ;CLEAR FILE NAME BUFFER JMP LBSW07 LBLS00: CMP (R6)+,(R6)+ ;CLEAN UP STACK MOV #OLLB,-(R6) RELEASE TST RENMFG ;WAS NAME CHANGED ? BNE LBLS03 ;YES - BRANCH MOV #OLFB+12,R3 MOV #ILFB+12,R0 MOV -(R3),-(R0) ;WRITE PERTINENT STUFF IN MOV -(R3),-(R0) ;OUTPUT LIBR R0 ASL R0 ADD (SP)+,R0 RETURN GETR50: GETCHR SETR50: MOV R5,R0 TSTR50: CMP R0,#'A BLT 1$ CMP R0,#'Z BLE 5$ 1$: CMP R0,#'0 BLT 2$ CMP R0,#'9 BLE 4$ 2$: CMP R0,#CH.DOT ; "." BEQ 4$ CMP R0,#CH.DOL ; "$" BEQ 3$ CMP R0,#SPACE BEQ 6$ MOV #100000+SPACE,R0 ;INVALID, FORCE MINUS 6$: SUB #SPACE-11,R0 3$: SUB #11-22,R0 4$: SUB #22-100,R0 5$: SUB #100,R0 RETURN CVTNUM: ;CONVERT TEXT TO NUMERIC ; IN - R2 RADIX ; OUT - VALUE RESULT ; R0 - HIGH BITIRE DISK. DSKVER: MOV #DPAT1,R0 ;TEST PATTERN FOR VERIFICATION MOV #TB,R1 ;POINTER TO DISK ADDRESS CLR @R1 ;DISK START ADDRESS: BLOCK 0 BIT #VERIFY,TASK ;IS /VERIFY REQUESTED ? BEQ 1$ ;NO MOV LIM,R2 ;YES, VERIFY ENTIRE DISK BR 2$ 1$: MOV BILIM,R2 ;BASIC INIT FINAL ADDRESS 2$: JSR PC,RPWR00 ;WRITE TEST PATTERN TO DISK BIT #REVER,TASK ;SHOULD REVERIFICATION BEGIN ? BNE 3$ ;YES CLR @R1 ;RESET DISK START ADDRESS JSR PC,RPRD00 ;READ VERIFY DISK BIT #REVER,TASK ;SHOULD REVERIFICOUTPUT BUF FULL MOV CURBUF,R3 ADD #78.,R3 CMP R1,R3 RTS PC DEFAULT=OCTCNV ;DEFAULT FORMAT IF NOT SPECIFIED OUTSEM: MOV #2,CMBUFH ;ASK FOR OUTPUT MOV #OUTLB,SEM+2 MOV #OUTFB,SEM+4 ;INTERFACE TO CSI2 OTSM00: MOV #SEM,-(R6) CSI2 BIT #SWER,@R6 ;TOO MANY SWITCHES? BEQ OTSM10 ;NO - BRANCH OTSM05: JMP FDSWER ;SWITCH ERROR OTSM10: CLR PASS ;ASSUME ONLY ONE FILE TO OUTPUT BIT #1,(R6)+ ;AND CHECK IF THAT IS TRUE BNE MORE ;NO MORE AFTER THIS ONE INC PASS ;INCREASE PARY FILE AND MOV -(R3),-(R0) ;LINK BLOCKS TO INPUT MOV -(R3),-(R0) ;LIBRARY FILE AND LINK MOV -(R3),-(R0) ;BLOCKS, RESPECTIVELY LBLS03: MOV OLLB+2,ILLB+2 MOVB OLLB+5,ILLB+5 MOV OLLB+6,ILLB+6 LBLS05: JSR PC,LBILIN ;INITIALIZE INPUT LIBRARY CLRB LBPASS ;SET PASS ONE CLR LBEDIR ;CLEAR EDIR & EOF FLAGS MOV #LLLB,-(R6) INIT ;INIT LISTING DEVICE MOV #LLFB,-(R6) MOV #LLLB,-(R6) OPEN ;OPEN LISTING FILE MOV #LLFB,R2 TST (R2) ;ANY NAME SPECIFIED? BNE LBLS10 ;YES MOV #OLFB,R - OVERFLOW ; - HIGH BYTE - CHARACTER COUNT ; - LOW BYTE - OVERSIZE COUNT SAVREG CLR R0 ;RESULT FLAG REGISTER CLR R1 ;NUMERIC ACCUMULATOR MOV CHRPNT,SYMBEG ;SAVE FOR RESCAN 1$: MOV R5,R3 ;GET A COPY OF THE CURRENT CHAR SUB #'0,R3 ;CONVERT TO ABSOLUTE CMP R3,#9. ;NUMERIC? BHI 9$ ; NO, WE'RE THROUGH CMP R3,R2 ;YES, LESS THAN RADIX? BLO 2$ ; YES INC R0 ;NO, BUMP "N" ERROR COUNT 2$: MOV R2,R4 ;COPY OF CURRENT RADIX CLR -(SP) ;TEMP AC 3$: ASR R4 ;SHIATION BEGIN ? BNE 3$ ;YES MOV #DPAT2,R0 ;TEST PATTERN FOR VERIFICATION CLR @R1 ;RESET DISK START ADDRESS JSR PC,RPWR00 ;WRITE TEST PATTERN TO DISK BIT #REVER,TASK ;SHOULD REVERIFICATION BEGIN ? BNE 3$ ;YES CLR @R1 ;RESET DISK START ADDRESS JSR PC,RPRD00 ;READ VERIFY TEST PATTERN ;FROM DISK 3$: RTS PC .SBTTL ZERO OPTION CONTROL ;DSKZER WRITES ZEROS TO THE ENTIRE DISK DSKZER: CLR R0 ;PATTERN TO CLEAR TRAN BUFFER CLR @R1 ;RESET DISK START ADDRESS MOV LIM,R2 ;LAST DISK ASS COUNT MORE: TST OUTLB+6 ;ANYTHING THERE? BNE OTSM15 ;YES - BRANCH TST PASS ;BUT NEXT ONE? BNE OTSM00 ;TRY THAT CLR R1 ;SET TO EXIT RETURN OTSM15: MOV #DEFAULT,R1 ;SET DEFAULT OUTPUT FORMAT MOV #OUTLB+10,R2 ;POINT AT SWITCHES DEC (R2)+ ;ARE THERE ANY? BLT OTSM40 ;NO - BRANCH OTSM20: CMP #OC,@R2 ;IS IT OCTAL? BNE OTSM25 ;NO - BRANCH MOV #OCTCNV,R1 BR OTSM40 OTSM25: CMP #BC,@R2 ;IS IT BYTES? BNE OTSM30 ;NO - BRANCH MOV #BYTCNV,R1 BR OTSM40 OTSM30: CMP #AC,@R2 2 ;NO, TRY OUTPUT LIBRARY NAME TST RENMFG ;IS IT TO BE RENAMED? BNE 1$ ;YES, USE INPUT NAME TST (R2) ;ANY OUTPUT LIBRARY? BNE LBLS10 ;YES 1$: MOV #ILFB,R2 ;NO, USE INPUT LIBRARY NAME LBLS10: .CVTDT #0,#DATE ;GET CURRENT DATE .CVTDT #1,#TIME ;GET CURRENT TIME MOV #LBLSTN,R4 ;UNPACK NAME AND PLACE JSR PC,LBERNM ;IN LISTING TITLE BUFFER MOV #LBTITL,R3 ;PRINT TITLE ON CALL LBLSWT ;LISTING TOO MOV #LBLSTB,R3 MOV #1,R0 ;INITIALIZE POSITION COUNTER LBLS20: JSR PC,LBLSWT ;WRITE THISFT RADIX BCC 4$ ;BRANCH IF NO ACCUMULATION ADD R1,(SP) ;ADD IN BCC 4$ ;BRANCH IF NO OVERFLOW BIS #100000,R0 ;OH, OH. FLAG IT 4$: TST R4 ;ANY MORE BITS TO PROCESS? BEQ 5$ ; NO ASL R1 ;YES, SHIFT PATTERN BR 3$ 5$: MOV (SP)+,R1 ;SET NEW NUMBER ADD R3,R1 ;ADD IN CURRENT NUMBER GETCHR ;GET ANOTHER CHARACTER ADD #000400,R0 ;TALLY CHARACTER COUNT BR 1$ 9$: MOV R1,VALUE ;RETURN RESULT IN "VALUE" RETURN ;RETURN, TESTING R0 TSTARG: ;TEST ARGUMENT CLR R0 ;ASSUME FBLOCK + 1 JSR PC,RPWR00 ;ZERO ENTIRE DISK RTS PC .SBTTL SUBROUTINE TO TRAN A GIVEN PATTERN TO DISK ; THIS ROUTINE TRANS A GIVEN DATA PATTERN TO DISK ; IN 10 BLOCK MODE. IF A TRAN ERROR OCCURS, THOSE ; BLOCKS ARE REWRITTEN IN SINGLE BLOCK MODE. WHEN ; THE FAILING BLOCK NO. IS IDENTIFIED, CONTROL IS ; TRANSFERRED TO RPER00, THE ERROR HANDLER. IF NO ; FAILING BLOCK IS IDENTIFIED, OR WHEN CONTROL IS ; RETURNED FROM RPER00, THE 10 BLOCK MODE RESUMES. RPWR00: JSR PC,BFIN00 ;INITIALIZE TRAN B;IS IT ASCII? BNE OTSM35 ;NO - BRANCH MOV #ASCCNV,R1 BR OTSM40 OTSM35: CMP #MC,@R2 ;IS IT RADIX UNPACK? BNE OTSM05 ;NO - ERROR MOV #RADCNV,R1 OTSM40: TSTB CHN ;IF IN CHAIN MODE, THEN BEQ OTSM42 ;OVERRIDE ANY OUTPUT SWITCH MOV #CHAIN,R1 OTSM42: MOV #OUTLB,-(R6) INIT ;INIT OUTPUT DEVICE MOV #OUTFB,-(R6) MOV #OUTLB,-(R6) OPEN ;OPEN OUTPUT FILE JSR PC,FDBLBF JSR PC,FLIP ;BLANK BOTH BUFFERS CLR FDCOUNT ;INITIALIZE THE COUNTER OTSM45: RTS PC OCTAL: MOV (R0)+,-(R6)  LINE LBLS25: MOV R0,-(R6) MOV #LBLSNO,-(R6) ;PUT NUMBER IN LIST BUFFER MOV #3,-(R6) UTILITY CALL GETID ;GET NAME AND IDENT FOR LISTING MOV #LBLSBF,R3 JSR PC,LBLSWT ;WRITE THIS LINE TSTB LBEDIR ;END OF DIRECTORY? BNE LBLS35 ;YES TSTB LBEOF ;END OF FILE? BNE LBLS40 ;YES CMP LBDATA,#EGSD ;END OF GSD? BNE 1$ ;NO CALL LBNX ;YES, GET NEXT RECORD BR 2$ ;AND CONTINUE 1$: JSR PC,LBSKPE ;SKIP TO NEXT ENTRY 2$: TSTB LBEDIR ;AT END? BNE LBLS35 ;YES - BRANCH TSTB LBEOF ;EALSE TST R5 ;IF EOL BEQ 3$ CMP R5,#CH.SMC ; OR SEMICOLON, BEQ 3$ ; FALSE TST ARGCNT ;FIRST ARGUMENT? BEQ 2$ ; YES, GOOD AS IS CMP R5,#CH.COM ;NO, COMMA? BEQ 1$ ; YES, BYPASS IT TST EXPFLG ;NO, WAS ONE REQUIRED? BEQ 2$ ; NO ERROR A ;YES, FLAG ERROR BR 2$ 1$: GETNB ;BYPASS COMMA 2$: SETNZ R0 ;FORCE TRUE INC ARGCNT ;INCREMENT ARGUMENT COUNT 3$: CLR EXPFLG TST R0 ;SET FLAGS RETURN TSTCOM: ;TEST FOR COMMA CLR R0 ;ASSUME FALSE CMP R5,#CH.COM ;LOUFFER MOV #BUF,TRNBF ;TRAN BUFFER MOV BSZW10,TRNWC ;10 BLOCK WORD COUNT MOV #WRITE,TRNFCN ;TRAN FUNCTION IS WRITE RPWR01: JSR PC,INTRN ;TRAN 10 BLOCKS TO DISK BMI RPWR03 ;BRANCH IF ANY ERRORS ;DURING TRAN ADD #10.,@R1 ;INCREMENT BLOCK COUNT TO ;NEXT 10. BLOCKS RPWR02: CMP @R1,R2 ;DONE BLO RPWR01 ;NOT YET, DO ANOTHER 10 BLOCKS RPWR06: RTS PC ;YES, RETURN ;THIS ROUTINE DOES A SINGLE BLOCK TRAN TO THE DISK RPWR03: MOV BSZW,TRNWC ;SET UP ONE BLOCK WORD COUNT MOV #10.,R3 ;S;ALL THE FOLLOWING GET OCT00: MOV R1,-(R6) ;INPUT AS FOLLOWS: MOV #5,-(R6) ; RO POINTS TO DATA EMT 42 ; R1 POINTS TO BUFFER SLOT ADD #6,R1 ;ALL BUMP R1 BY DATA LENGTH RTS PC BYTES: CLR -(R6) MOVB (R0)+,@R6 MOV #TMPBUF,-(R6) MOV #5,-(R6) EMT 42 MOVB TMPBUF+3,(R1)+ MOVB TMPBUF+4,(R1)+ MOVB TMPBUF+5,(R1)+ RTS PC RADIX: MOV (R0)+,-(R6) RAD00: MOV R1,-(R6) MOV #1,-(R6) EMT 42 ADD #3,R1 RTS PC ASCII: MOVB @R0,@R1 BICB #200,@R1 CMPB @R1,#40 BLO ASC00 CMPND OF FILE? BNE LBLS40 ;YES - DONE BR LBLS25 ;BRANCH AROUND AGAIN LBLS35: TSTB LBPASS ;IS THIS PASS TWO? BNE LBLS40 ;YES - DONE TST LLLB+10 ;ANY SWITCHES? BEQ LBLS40 ;NO - BRANCH CMP #OBJLST,LLLB+12 ;IS IT /LO? BEQ LBLS50 ;YES - BRANCH MOV #LLLB,-(R6) CLOSE ;CLOSE LISTING FILE MOV #6,R0 ;REPORT ERROR JMP LBSWER LBLS40: MOV #ILLB,-(R6) CLOSE ;CLOSE FILES MOV #LLLB,-(R6) CLOSE TSTB LBDEL ;DELETE INPUT LIBRARY BEQ LBLS43 ;NO - BRANCH MOV #ILFB,-(R6) MOV #ILOKING AT ONE? BNE 1$ ; NO, EXIT FALSE GETNB ;YES, BYPASS SETNZ R0 ;SET TRUE 1$: TST R0 ;SET FLAG RETURN SETSYM: ;SET SYMBOL FOR RE-SCAN MOV SYMBEG,CHRPNT ;SET THE POINTER BR SETCHR ;SET CHARACTER AND FLAGS GETNB: ;GET A NON-BLANK CHARACTER GETCHR ;GET A VIRGIN SETNB: SETCHR CMP R5,#SPACE BEQ GETNB ;LOOP ON SPACES CMP R5,#TAB BEQ GETNB ; AND TABS TST R5 ;SET FLAGS RETURN GETCHR: ;GET THE NEXT CHARACTER INC CHRPNT ;BUMP POINTER SETCHR: MOVB @CHRET TO DO BLOCK BY BLOCK RPWR04: JSR PC,INTRN ;ONE BLOCK TRAN TO DISK ;NOTE: OPERATOR ACTION IS ;REQUIRED IF THE ERROR IS ;IN THE MFD OR BIT MAPS BPL RPWR05 ;BRANCH IF NO ERRORS DURING TRAN JSR PC,RPER00 ;ERROR DURING TRAN BIT #REVER,TASK ;SHOULD REVERIFICATION BEGIN ? BNE RPWR06 ;YES RPWR05: INC @R1 ;INCREMENT COUNTER TO NEXT BLOCK DEC R3 ;DONE 10. INCREMENTS YET? BGT RPWR04 ;NO, GO TRAN NEXT BLOCK MOV BSZW10,TRNWC ;YES, RESTORE 10 BLOCK WORD ;COUNT AND BR RPWR02B @R1,#137 ;IS CHARACTER PRINTABLE? BHI ASC00 ;NO - BRANCH MOVB (R0)+,(R1)+ ;ENTER IN BUFFER RTS PC ASC00: MOVB #137,(R1)+ ;ENTER DEFAULT CHARACTER INC R0 ;BUMP POINTER RTS PC ; ; NO INPUT FILE ; FDNOIN: JSR PC,FILCR ;FILE CLEANUP CLR -(R6) MOV #2206,-(R6) ;NO INPUT FILE YELL: IOT CALL RINIT ;SET INTIAL CONDITIONS JMP FLDP05 ;GO INPUT COMMAND STRING AGAIN ; ; TOO MANY INPUT FILES ; FDINER: JSR PC,FILCR ;FILE CLEANUP CLR -(R6) MOV #2205,-(R6) BR YELL ; ; SWITCH ERRORLB,-(R6) DELETE LBLS43: MOV #ILLB,-(R6) RELEASE ;RELEASE DEVICES MOV #LLLB,-(R6) RELEASE LBLS45: JMP LIB00 LBLS50: INCB LBPASS ;SET PASS TWO CLRB LBEDIR ;CLEAR END DIR FLAG JSR PC,LBINRD ;GET FIRST OBJ MOD LINE MOV #LBPGND,R3 JSR PC,LBLSWT ;OUTPUT A FORM FEED MOV #LBOBJ,R2 ;OUTPUT OBJ HEADER BR LBLS10 ; ; GET THE MODULE NAME AND IDENT (IF ANY) FOR PLACEMENT ; IN THE LISTING BUFFER. ; GETID: MOV R0,-(SP) ;SAVE SOME MOV R1,-(SP) ;SCRATCH MOV #ID,R1 ;AND CLEAR MOV #PNT,R5 ;SET REGISTER AND FLAGS RETURN .SBTTL ROLL HANDLERS SSRCH: ;USER DEFINED OPERATOR SEASRCH SEARCH SYMROL RETURN OSRCH: ;OP-CODE SEARCH SEARCH PSTROL RETURN MSRCH: SEARCH MACROL RETURN LSRCH: ;LOCAL SYMBOL SEARCH MOV #LSYFLG,R0 ;POINT TO FLAG (AND BLK) MOV R1,-(SP) ;SAVE R1 MOV #SYMBOL,R1 TST (R0)+ ;FLAG SET? BEQ 1$ ; NO CLR -(R0) ;YES, CLEAR IT TST (R0)+ INC (R0) ;INCREMENT BLOCK NUMBER 1$: MOV (R0),(R1)+ ;MOVE INTO "SYMBOL" MOV VALUE,(R1)  ;RETURN TO DO ANOTHER 10 BLOCK ;TRAN .SBTTL SUBROUTINE TO INITIALIZE DISK TRAN BUFFER BFIN00: MOV #BUF,R3 ;TRAN BUFFER START ADDRESS MOV R3,R4 ADD BSZB10,R4 ;BUFFER END TST R0 ;IS INITIALIZATION WORD ALL ;ZEROS ? BEQ BFIN02 ;YES, GO CLEAR BUFFER BFIN01: MOV R0,(R3)+ ;INITIALIZE BUFFER WORD CMP R3,R4 ;END OF BUFFER ? BLO BFIN01 ;NO, INITIALIZE ANOTHER WORD RTS PC ;YES, RETURN BFIN02: CLR (R3)+ ;CLEAR BUFFER WORD CMP R3,R4 ;END OF BUFFER ? BLO BFIN02 ;NO, CLE ; FDSWER: JSR PC,FILCR ;FILE CLEANUP CLR -(R6) MOV #2203,-(R6) ;TOO MANY SWITCHES BR YELL ;COMMAND STRING ; ; INPUT DEVICE ERROR ; FDEVER: JSR PC,FILCR ;FILE CLEANUP CLR -(R6) MOV #2256,-(R6) ;ERROR INDICATOR BR YELL ; ; DETECTED READ ERROR ; FDFTER: MOV INBUF+2,-(R6) ;STATUS CODE FDFT00: JSR PC,FILCR ;FILE CLEANUP BIC #377,(R6) SWAB (R6) MOV #2202,-(R6) BR YELL RINIT: CLR PASS ;CLEAR THE PAS COUNT CLR OUTLB CLR INLB CLR CMDLB MOV #40003,INBUF+2 CLR TMPR1�LBIDEN,R0 ;THE 10$: MOVB #' ,(R0)+ ;IDENT SOB R1,10$ ;FIELD .RADUP #LBLSNM,LBDATA+2;UNPACK MODULE .RADUP #LBLSNM+3,LBDATA+4;NAME AND PUT IN THE BUFFER 1$: MOV #LBDATA,R1 ;GET DATA ADDRESS MOV LINBUF+4,R0 ;GET BYTE COUNT CMP (R1)+,#EGSD ;END OF GSD? BEQ 5$ ;YES, QUIT LOOKING SUB #2,R0 ;DECREMENT BYTE COUNT 2$: TST R0 ;ANYTHING LEFT IN LINE? BLE 4$ ;NO SUB #8.,R0 ;DECREMENT COUNT CMP 4(R1),#IDENT ;.IDENT? BNE 3$ ;NO .RADUP #LBIDEN,(R1) ;YES, PACK .RADUP #LBIDEN+3,2(R1) ;  TSTB (R1)+ ;NUMBER = 0? BEQ 2$ ; YES, ERROR TSTB (R1) ;NO, OVERFLOW? BEQ 3$ ; NO 2$: ERROR T ;YES, FLAG ERROR 3$: MOV (SP)+,R1 ;RESTORE REG SEARCH LSYROL ;SEARCH THE ROLL RETURN .CSECT IMPPAS LSYFLG: .BLKW ;BUMPED AT "LABEL:" LSYBLK: .BLKW ;BLOCK NUMBER .CSECT SEARCH: ;BINARY ROLL SEARCH CALL SETROL ;SET ROLL REGISTERS SUB R3,R1 ;POINT ONE SLOT LOW MOV R2,R3 SUB R1,R3 ;COMPUTE SIZE CLR R0 ;GET SET TO COMPUTE SEARCH OFFSET SEC ; (R0 DOUBLES AS T/F FAR ANOTHER WORD RTS PC ;YES, RETURN .SBTTL SUBROUTINE TO VERIFY AND TRAN TEST PATTERN FROM DISK ; THIS ROUTINE CLEARS A BUFFER AND TRANS FROM DISK ; IN 10 BLOCK MODE AND VERIFIES THE DATA IN THE BUFFER. ; IF EITHER A TRAN ERROR OCCURS OR THE DATA IS NOT ; CORRECT, THIS IS REPEATED IN SINGLE BLOCK MODE. ; WHEN THE FAILING BLOCK NO. IS IDENTIFIED, CONTROL IS ; TRANSFERRED TO RPER00, THE ERROR HANDLER. IF NO ; FAILING BLOCK IS IDENTIFIED, OR WHEN CONTROL IS ; RETURNED FROM RPER00, THE 10 BLOCK ;SET NOT IN TRAN STATE CLR FILEXT+4 MOVB #'.,FILEXT CLRB CHN ;SET NOT IN CHAIN MOV #CMDLB,-(R6) INIT ;INIT INPUT COMMAND DEVICE MOV #OCMLB,-(R6) INIT ;INIT OUTPUT COMMAND DEVICE RTS PC ;EXIT SUBROUTINE ; ; FILE CLOSE AND RELEASE ROUTINE ; FILCR: TST CMDLB ;COMMAND LINK BLOCK BEQ FILCA ;NO, CHECK NEXT BLOCK MOV #CMDLB,-(R6) CLOSE MOV #CMDLB,-(R6) RELEASE FILCA: TST INLB ;INPUT LINK BLOCK INITED? BEQ FILCB ;NO, CHECK NEXT BLOCK MOV @PC,INFB ;FORCE A "FILE NAME"THE NAME BR 5$ ;AND GO AWAY 3$: ADD #8.,R1 ;SKIP OVER ENTRY BR 2$ 4$: CALL LBNX ;GET ANOTHER LINE TST LBEDIR ;END OF DIRECTORY? BNE 5$ ;YES, EXIT TSTB LBEOF ;END OF FILE? BEQ 1$ ;NO, GO AGAIN 5$: MOV (SP)+,R1 ;RESTORE MOV (SP)+,R0 ;REGISTERS RETURN LBEXIT: ;EXIT PROCESSOR MOV #OLLB,-(R6) CLOSE ;CLOSE OUTPUT LIBRARY TST ILLB+6 ;INPUT LIBRARY OPEN? BEQ LBEX10 ;NO - BRANCH MOV #ILLB,-(R6) CLOSE ;CLOSE INPUT LIBRARY TST RENMFG ;WAS THE NAME CHANGED? BEQ LAG) 1$: ROL R0 ;SHIFT BIT BIC R0,R3 ;CLEAR CORRESPONDING BIT. LAST ONE? BNE 1$ ; NO BR 5$ ;START AT HALF-WAY POINT 2$: CMP R2,R1 ;OFF IN NO-MANS'S LAND? BLOS 4$ ; YES CMP (R4),(R1) ;NO, FIRST WORDS MATCH? BNE 3$ ; NO CMP 2(R4),2(R1) ;YES, HOW ABOUT SECOND? BEQ 7$ ; YES, FOUND 3$: BHI 5$ ;NO, BRANCH IF TOO HIGH 4$: SUB R0,R1 ;LOWER INDEX BR 6$ 5$: ADD R0,R1 6$: ASR R0 ;END OF ITERATION, HALVE OFFSET BIC #2,R0 ;END? BNE 2$ ; NO ADD #4,R1 ;YES, POINT TO  MODE RESUMES. RPRD00: MOV #BUF,R5 MOV R5,TRNBF ;TRAN BUFFER ADD BSZB10,R5 ;END OF 10 BLOCK BUFFER MOV BSZW10,TRNWC ;10 BLOCK WORD COUNT MOV #READ,TRNFCN ;TRAN FUNCTION IS READ RPRD01: MOV R0,-(SP) CLR R0 JSR PC,BFIN00 ;CLEAR TRAN INPUT BUFFER MOV (SP)+,R0 JSR PC,INTRN ;TRAN 10 BLOCKS FROM DISK BMI RPRD04 ;BRANCH IF ANY ERRORS DURING ;TRAN MOV TRNBF,R4 ;TRAN BUFFER START RPRD02: CMP (R4)+,R0 ;IS DATA CORRECT ? BNE RPRD04 ;NO, ERROR CMP R4,R5 ;DONE 10 BLOCK VERIFICATION MOV #INFB,-(R6) MOV #INLB,-(R6) LOOKUP ;LOOKUP INPUT FILE INFO TST (R6)+ ;GET RID OF LENGTH BIT #40,(R6)+ ;IS INPUT FILE OPEN? BEQ FILC10 ;NO - BRANCH MOV #INLB,-(R6) CLOSE FILC10: MOV #INLB,-(R6) RELEASE FILCB: TST OUTLB ;OUTPUT LINK BLOCK INITED? BEQ FILCC ;NO, GO EXIT MOV #OUTFB,-(R6) MOV #OUTLB,-(R6) LOOKUP ;LOOKUP OUTPUT FILE INFO TST (R6)+ ;GET RID OF LENGTH BIT #40,(R6)+ ;IS OUTPUT FILE OPEN BEQ FILC20 ;NO - BRANCH MOV #OUTLB,-(R6) CLOSE FILC20: MOVLBEX00 ;NO - BRANCH MOV #ILFB,-(R6) MOV #ILLB,-(R6) ;/DL IS IMPLIED DELETE MOV #ILFB,-(R6) MOV #OLFB,-(R6) MOV #OLLB,-(R6) RENAME BR LBEX05 LBEX00: TSTB LBDEL ;/DL ON INPUT LIBR? BEQ LBEX05 ;NO - BRANCH (ASSUME /S) MOV #ILFB,-(R6) MOV #ILLB,-(R6) DELETE CLRB LBDEL ;INTERFACE TO LISTING LBEX05: MOV #ILLB,-(R6) RELEASE ;RELEASE INPUT LIBR DEVICE LBEX10: MOV #OLLB,-(R6) RELEASE ;RELEASE OUTPUT LIBR DEVICE JMP LBLIST ;CHECK FOR LISTING LIBROM: ;REPLACES AN OB INSERTION SLOT 7$: BR SCANX ;EXIT THROUGH SCAN NEXT: ;GET THE NEXT ENTRY CALL SETROL MOV ROLUPD,R0 ADD R0,R1 ADD R3,R0 CMP R1,R2 BLO SCANX BR SCANF SCANW: ;SCAN ONE WORD CALL SETROL ;SET REGISTERS CLR R0 ;ASSUME FALSE 1$: INC R0 ;TALLY ENTRY COUNT CMP (R4),(R1) ;MATCH? BEQ 2$ ; YES ADD R3,R1 ;NO, INCREMENT POINTER CMP R1,R2 ;FINISHED? BLO 1$ ; NO CLR R0 RETURN ;YES, EXIT FALSE 2$: MOV R4,R2 ;POINT TO "SYMBOL" NEG R3 ;NEGATE ENTRY SIZE JMP X  ? BLO RPRD02 ;NO, VERIFY ANOTHER WORD ADD #10.,@R1 ;INCREMENT BLOCK COUNT TO ;NEXT 10. BLOCKS RPRD03: CMP @R1,R2 ;DONE BLO RPRD01 ;NOT YET, DO ANOTHER 10 BLOCKS RPRD11: RTS PC ;YES, RETURN ;THIS ROUTINE DOES A SINGLE BLOCK TRAN FROM THE DISK RPRD04: MOV #BUF,R5 ;END OF 1 BLOCK BUFFER ADD BSZB,R5 MOV BSZW,TRNWC ;SET UP ONE BLOCK WORD COUNT MOV #10.,R3 ;SET TO DO BLOCK BY BLOCK RPRD05: MOV R0,-(SP) MOV R3,-(SP) CLR R0 JSR PC,BFIN00 ;CLEAR TRAN INPUT BUFFER MOV (SP)+,R�� #OUTLB,-(R6) RELEASE FILCC: TST OCMLB ;OUTPUT COMMAND LINK BLOCK INITED? BEQ FILCD ;NO, GO EXIT MOV #OCMLB,-(R6) CLOSE MOV #OCMLB,-(R6) RELEASE FILCD: RTS PC ; ; RESTART ROUTINE ; RSTT: JSR PC,FILCR ;FILE CLEANUP JSR PC,RINIT ;INITIALIZE CONDITIONS JMP FLDP05 ;GO PRINT #. .END FLDP00 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� JECT MODULE ;INPUT: FIRST LINE OF MODULE ;IN LBFLBF, FIRST LINE OF A ;DIRECTORY OR OBJ MODULE IN ;LINBUF LBRM00: MOV #LBFDTA+2,R4 ;POINT AT NAME MOV #LBDATA+2,R1 CMP (R1)+,(R4)+ BNE LBRM10 CMP (R1)+,(R4)+ ;THIS THE RIGHT ENTRY? BNE LBRM10 ;NO-BRANCH JSR PC,LBSKPE ;SKIP THIS ENTRY TSTB LBPASS ;CREATE DIRECTORY ENTRY? BEQ LBRM05 ;YES - BRANCH JSR PC,LBCOM RTS PC LBRM05: JSR PC,LBCDIR RTS PC LBRM10: JSR PC,LBNXTE TST LBEDIR ;END DIR OR EOF IS A BEQ LBRM00 MIT0(R3) ;MOVE ENTRY ANS EXIT SCAN: ;LINEAR ROLL SCAN CALL SETROL ;SET ROLL REGISTERS CLR R0 ;ASSUME FALSE 1$: CMP R2,R1 ;END? BEQ SCANF ; YES, EXIT FALSE INC R0 CMP (R4),(R1) ;NO, MATCH ON FIRST WORDS? BNE 2$ ; YES CMP 2(R4),2(R1) ;NO, HOW ABOUT SECOND? BEQ SCANX ; YES 2$: ADD R3,R1 ;INCREMENT BY SIZE BR 1$ SCANF: MOV R0,SECTMP CLR R0 ;FALSE EXIT SCANX: MOV R1,ROLPNT ;SET ENTRY POINTER MOVB ROLSIZ(R5),R3 ADD R4,R3 ;COMPUTE END MOV R0,ROLUPD ;SAVE FLAG B3 MOV (SP)+,R0 JSR PC,INTRN ;ONE BLOCK TRAN FROM DISK ;NOTE: OPERATOR ACTION IS ;REQUIRED IF THE ERROR IS ;IN THE MFD OR BIT MAPS BMI RPRD08 ;BRANCH IF ERRORS DURING TRAN RPRD06: MOV TRNBF,R4 ;TRAN BUFFER START RPRD07: CMP (R4)+,R0 ;IS DATA CORRECT ? BEQ RPRD09 ;YES RPRD08: JSR PC,RPER00 ;NO,REPORT ERROR BIT #REVER,TASK ;SHOULD REVERIFICATION BEGIN ? BNE RPRD11 ;YES BR RPRD10 RPRD09: CMP R4,R5 ;DONE 1 BLOCK VERIFY ? BLO RPRD07 ;NO, VERIFY ANOTHER WORD RPRD10: INC �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������� ;MODULE NOT FOUND ERROR MOV #LBFDTA+2,R2 BR LBDM10 LIBDOM: ;DELETES AN OBJECT MODULE ;INPUT: FIRST LINE OF A DIR ;ENTRY OR OBJ MODULE IN LINBUF ;MODULE NAME TO DELETE IN ;LBTNAM AND LBTNAM+2 ;OUTPUT: FIRST LINE OF FOLLOWING ;DIR OR OBJ MODULE IN LINBUF ;OR LBEDIR, OR LBEOF SET TST LBEDIR ;ANY MORE LEFT TO DELETE? BNE LBDM07 ;NO - ERROR LBDM00: MOV #LBDATA+2,R1 CMP (R1)+,LBTNAM BNE LBDM05 CMP (R1)+,LBTNAM+2 ;THIS THE RIGHT ENTRY? BEQ LBDMNE 1$ ; YES CMP (R4)+,(R4)+ MOV #ZEROS,R1 ; NO, SET TO ZEROS 1$: MOV (R1)+,(R4)+ ;COMPLETE TRANSFER CMP R4,R3 BLO 1$ ;TEST FOR END RETURN ZEROS: .WORD 0,0,0 APPEND: ;APPEND TO END OF ROLL CALL SETROL MOV R2,ROLPNT ;SET POINTER CLR ROLUPD BR INSERF INSERT: ;INSERT IN ROLL CALL SETROF ;SET ROLL REGISTERS (BUT NO ARG) INSERF: MOV ROLPNT,R0 ;POINTS TO PROPER SLOT TST ROLUPD ;WAS SEARCH TRUE? BNE 5$ ; YES INCB ROLSIZ+1(R5) ;UPDATE ENTRY COUNT ADD R3,ROLTOP(R5@R1 ;YES, INCREMENT COUNTER TO ;NEXT BLOCK DEC R3 ;DONE 10. INCREMENTS YET? BGT RPRD05 ;NO, GO TRAN NEXT BLOCK MOV #BUF,R5 ;END OF 10 BLOCK BUFFER ADD BSZB10,R5 MOV BSZW10,TRNWC ;RESTORE 10 BLOCK WORD COUNT AND BR RPRD03 ;RETURN TO DO ANOTHER ;10 BLOCK TRAN .SBTTL DISK ERROR PROCESSOR ;AN ERROR EXISTS IN SINGLE BLOCK INITIALIZATION ; IF FAILING BLOCK NO. IS 0 OR 1, THE PACK IS ; UNSUITABLE FOR DOS/BATCH USE. A DIAGNOSTIC MESSAGE ; IS ISSUED AND AN EXIT IS TAKEN. ; I��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������20 ;YES - BRANCH LBDM05: JSR PC,LBNXTE ;GET NEXT ENTRY BR LIBDOM LBDM07: MOV #LBTNAM,R2 LBDM10: MOV #2245,LBERNO ;INTERFACE TO SWITCH ERROR LBDM15: MOV #LXERFL,R4 JSR PC,LBERNM ;ENTER MODULE NAME CLR LXEREX ;IN ERROR BUFFER CLR LXEREX+2 ;AND CLEAR EXTENT CLR -(R6) MOV LBERNO,-(R6) JMP LBSE00 ;GO PROCESS ERROR LBDM20: JSR PC,LBSKPE ;SKIP THIS ENTRY RTS PC LIBIOM: ;INSERTS AN OBJECT MODULE ;INPUT: FIRST LINE OF OBJECT ;MODULE IN LBFLBF ;LINBUF CONTAINS FIRST LIN) ;UPDATE TOP POINTER CMP R2,ROLBAS+2(R5) ;GAP BETWEEN ROLLS? BNE 5$ ; YES, JUST STUFF IT SUB R3,R0 MOV ROLBAS+0,R1 ;NO, GET ABSOLUTE BASE MOV R1,R2 SUB R3,R2 ;R2 POINTS ONE SLOT DOWN CMP R2,MACTOP ;OVERFLOW? BHI 3$ ; NO, OK SERROR 1 2$: MOV (R1)+,(R2)+ ;MOVE AN ENTRY DOWN 3$: CMP R0,R2 ;END? BNE 2$ ; NO 4$: SUB R3,ROLBAS(R5) ;DECREMENT POINTERS SUB R3,ROLTOP(R5) SUB #2,R5 ;MORE ROLLS? BGE 4$ ; YES 5$: ASR R3 ;HALVE SIZE COUNT 6$: MOV (R4)+,(R0)+ ;MOVE AN ENTRYF THE FAILING BLOCK NO. IS NOT 0 OR 1, ; BADB.SYS IS UPDATED TO REFLECT THIS ERROR. ; IF THE VERIFY OPTION WAS NOT REQUESTED, BUT THE ; ERROR IS WITHIN THE SYSTEM AREA, THE INITIALIZER ; WILL RESTART AS IF THE VERIFY OPTION WAS REQUESTED. RPER00: CMP @R1,#1 ;IS ERROR IN BLOCK 0 OR 1 ? BHI 1$ ;NO, CONTINUE ERROR ANALYSIS JSR PC,RPACT ;YES, DISK PACK UNSUITABLE ;FOR DOS/BATCH 1$: JSR PC,BADBI ;ENTER FAILING BLOCK NO. ;INTO BADB.SYS BIT #VERIFY,TASK ;IS /VERIFY REQUESTED ? BNE 2$ ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������E ;OF A DIRECTORY ENTRY, FIRST ;LINE OF AN OBJECT MODULE, ;THE END DIR LINE IF LBEDIR ;IS SET, OR ANYTHING IF ;LBEOF IS SET LBIM00: TSTB LBEDIR ;ENDDIR IN LINBUF? BNE LBIM05 ;YES - BRANCH TSTB LBEOF ;AT END OF FILE? BEQ LBIM20 ;NO - BRANCH LBIM05: TST R4 ;INSERT AT END? BLT LBIM10 ;YES - BRANCH CMP R0,R4 ;THIS THE PROPER POSITION? BNE LBIM30 ;NO - BRANCH LBIM10: TSTB LBPASS ;PASS ONE? BNE LBIM15 ;NO - BRANCH JSR PC,LBCDIR ;CREATE DIRECTORY RTS  INTO PLACE DEC R3 BNE 6$ ;LOOP IF NOT END RETURN ZAP: ;EMPTY A ROLL CALL SETROL MOV R1,ROLTOP(R5) ;MAKE TOP = BOTTOM CLRB ROLSIZ+1(R5) ;CLEAR ENTRY COUNT RETURN SETROL: ;SET ROLL REGISTERS MOV R0,ROLNDX ;SET ARGUMENT SETROF: MOV (SP)+,R0 ;SAVE RETURN ADDRESS SAVREG ;SAVE REGISTERS MOV R5,-(SP) ; AND CURRENT CHARACTER MOV ROLNDX,R5 ;SET INDEX MOV ROLBAS(R5),R1 ;CURRENT BASE MOV ROLTOP(R5),R2 ;CURRENT TOP MOVB ROLSIZ(R5),R3 ;ENTRY SIZE MOV #SYMBOL,R4 ;POINTER ;NO, CONTINUE CMP @R1,BILIM ;IS BLOCK WITHIN DOS/BATCH FILE ;STRUCTURE AREA ? BHI 2$ ;NO BIS #VERIFY+REVER,TASK ;SET /VERIFY ;AND REVERIFY FLAGS 2$: RTS PC .SBTTL ENTER BLOCK NO. INTO BADB.SYS ;BADBI INSERTS A FAILING BLOCK NUMBER INTO BADB.SYS. ; NOTE THAT BADB.SYS IS A CORE RESIDENT BUFFER CONTAINING ; BLOCK NUMBERS OF FAULTY DISK BLOCKS IN SEQUENTIAL ORDER. ; THE UNUSED PART OF THE BUFFER CONTAINS ZEROS. BADBI: JSR R5,REGSAV ;SAVE REGS USED BY BADBI MOV BADB,R0 ;GET STAR��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������PC LBIM15: JSR PC,LBCOM ;CREATE OBJECT MODULE RTS PC LBIM20: TST R4 ;INSERT AT END? BLT LBIM25 ;YES - BRANCH CMP R0,R4 ;THIS THE PROPER POSITION? BEQ LBIM10 ;YES - BRANCH BGT LBIM30 ;BRANCH IF OUT OF ORDER LBIM25: JSR PC,LBNXTE ;GET NEXT ENTRY & TRY AGAIN BR LBIM00 LBIM30: MOV #LBFDTA+2,R2 LBIM35: MOV #2244,LBERNO ;OUT OF ORDER ERROR BR LBDM15 LBNXTE: ;WRITES OUT CURRENT ENTRY ;INPUT: FIRST LINE OF A ;DIRECTORY ENTRY OR OBJ MODULE ;IN LINBUF ;OUTPUT: FIRS TO SYMBOL CALL (R0) ;CALL PROPER ROUTINE MOV (SP)+,R5 ;RESTORE CURRENT CHARACTER RETURN ; AND REST OF REGS .SBTTL REGISTER STORAGE SAVREG: ;SAVE REGISTERS MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV 6.(SP),-(SP) ;PLACE RETURN ADDRESS ON TOP MOV R4,8.(SP) JSR PC,@(SP)+ ;RETURN THE CALL MOV (SP)+,R1 ;RESTORE REGISTERS MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 TST R0 ;SET CONDITION CODES RETURN XMIT7: MOV (R1)+,(R2)+ XMIT6: MOV (R1)+,(R2)+ XMIT5: MOV (R1)+,(R2)T OF BUFFER MOV BADBL,R2 ;GET END OF BUFFER 1$: CMP R0,R2 ;IS THE BUFFER EXHAUSTED ? BHIS 3$ ;YES, PLACE THE BAD BLOCK ;NO. HERE. CMP (R1),(R0)+ ;IS BLOCK NO. ;> THAN NO. IN ENTRY ? BHI 1$ ;YES BEQ 4$ ;IS BLOCK NO. = NO. IN ENTRY ? 2$: MOV -(R2),2(R2) ;MOVE HIGHER BLOCK NUMBER CMP R0,R2 ;ENTRIES HIGHER IN THE LIST BLOS 2$ ;TO MAKE ROOM FOR ENTERING ;THE CURRENT FAILING BLOCK NO. 3$: MOV (R1),(R2) ;ENTER FAILING BLOCK NO. ADD #2,BADBL ;EXTEND LIST BY 1 WORD 4$: JSR����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������!+ XMIT4: MOV (R1)+,(R2)+ XMIT3: MOV (R1)+,(R2)+ XMIT2: MOV (R1)+,(R2)+ XMIT1: MOV (R1)+,(R2)+ XMIT0: RETURN MOVBYT: ;MOVE BYTE STRING 1$: MOVB (R1)+,(R2)+ ;MOVE ONE BNE 1$ ;LOOP IF NON-NULL TSTB -(R2) ;END, POINT BACK TO NULL RETURN .SBTTL MACRO HANDLERS .IF NDF XMACRO .GLOBL REPT, ENDR REPT: ;REPEAT HANDLER ABSEXP ;EVALUATE COUNT SETPF1 ;MARK THE LISTING CALL GETBLK ;GET A STORAGE BLOCK CLR (R2)+ ;START IN THIRD WORD MOV VALUE,-(SP) ;SAVE COUNT CLR -" R5,REGRES ;RESTORE REGS CMP TOOBIG,BADBL ;SET V CONDITION IF BUFFER ;OVERFLOW RTS PC .SBTTL DELETE BLOCK NO. FROM BADB.SYS ; BADBU DELETES A BLOCK NO. FROM BADB.SYS ; AND REPACKS BADB.SYS WHEN REQUESTED ; BY THE OPERATOR DURING MARK MODE. BADBU: JSR R5,REGSAV ;SAVE REGS USED BY THIS ;SUBROUTINE MOV BADB,R0 ;START OF BADB BUFFER MOV BADBL,R2 ;END OF BADB BUFFER 1$: CMP R0,R2 ;END OF BUFFER ? BHIS 3$ ;YES, RETURN CMP (R1),(R0)+ ;NO, IS THIS ENTRY TO BE ;DELETED ? B������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������ �0 B0LID EN . PCS RT: W0LSLB ERFTLBP JM E OD CLEFIG INSTLIT SE ;0 ,R#6V MO H ������������������������������������������������������ RTTA SND.E C ND.E 1 = T ARST TNXFF DIF . ATNEE ;B T ECCS . P:LTMP IN LIMP ICTSE.C : TPPPIM ASPPIMT ECCS . P:UTMP IS ORCTSEE URMP IUT OSELO;C REPUIMT ECCS . IN FTLBT.S DCEN . CTSE.C W LK.B: AXGMAR KWBL .T:CNON CT UNCOL VELEO CRMA ; KWBL .L:LVAC MW LK.B: XTCNMA GERATO SEDERRD OOFD EN ; : NDBEMS ERNTOI PADREO CRMA ; KWBL .P:MRSB M. TC ET,UNCOT EAEP;R 2KWBL .T:CNSB MK OCBLG ARO TERNTOI;P W LK.B: RGBAMS CKLO BXTTEC SIBAO %(SP) ;NO ARGUMENTS MOV R0,-(SP) ; AND START OF BLOCK 1$: CALL ENDLIN ;POLISH OFF LINE CALL GETMLI ;GET A PRE-TESTED LINE BMI 10$ ;BRANCH IF EOF BIT #DFLRPT,R0 ;REPEAT TYPE? BEQ 2$ ; NO, ACCEPT AS IS INC R3 ;YES, ASSUME .REPT CMP #ENDR,VALUE ;TRUE? BNE 2$ ; YES DEC R3 ;NO, .ENDR DEC R3 BMI 10$ ;BRANCH IF END 2$: MOV #LINBUF,R1 ;SET TO START OF LINE 3$: MOVB (R1)+,R5 ;SET CHARACTER TO STORE CALL WCIMT ;DO IT BNE 3$ ;LOOP IF NON-ZERO BR 1$ ;PROCESS NEXT LINE 10&HI 1$ ;NO BLO 3$ ;NO MOV R0,R3 ;YES, DELETE IT AND SUB #2,R3 ;REPACK BADB 2$: MOV (R0)+,(R3)+ CMP R3,R2 BLO 2$ SUB #2,BADBL 3$: JSR R5,REGRES ;RESTORE REGS USED BY ROUTINE RTS PC ;RETURN .SBTTL LIST OR PRINT BADB.SYS ; ALL OUTPUT IS TO THE LP IF IT EXISTS; ; OTHERWISE, OUTPUT IS TO THE TTY. LISTBB: JSR R5,REGSAV ;SAVE REGISTERS TST TASK ;IS IT RP ? BMI 1$ ;YES, CONTINUE .WRITE #TTYLB1,#DEVRP ;NO, PRINT DIAGNOSTIC MESSAGE .WAIT #TTYLB1 ;AND EXIT .EXIT 1$: MOV NCRA B -NO ;0 SWBL LEQ B S?ORRR EALAT FNY;A) R33(R,TEFA #TBBI E AT W 6)(R,-LBLL #OV M NELIS HI TTERI;W E ITWR ) R6-(B,LL#LV MO R FEUF BNELIO TTSINPO3 ;R) R6-(3, ROV MT:SWBL L C PTS R0:N0BI LR TEBF LMP J DECOE IL FUTNP IET;S R0R CL H NCRA B -NO ;0 N0BI LEQ B S?ORRR EALAT FNY;A) R33(R,TEFA #TBBI E AT W LEFIT PUIN ;6)(R,-LBIF #OV M OMFRE IN LXTNED EA;R D EA R 6)(R,-LBIF #OV M ERFFBUE IN LTOS NTOI PR3 ;6)(R,-R3V MO: FLINLB PCS RT: 00OTLB ERFTLBP JM E OD CRYRAIB LUTTPOUT SE ;0 ,R TERNTOI;P W LK.B: XTBTMS ERNTOI PCKLO BUSIOEVPR ; KWBL .P:PBSB ME YP TCKLO;B W LK.B: YPBTMS D)REDEORE BSTMU (CKLO BLEABSHPU ; : LKBBMS REPUIMT ECCS . TNXFF NDF .I C ND.E N URET R NTOU CELEV LNTMEREEC;D VLCLMAC DE T SIPODER FOK OCBLN URET;R ACMMREL AL C NKLIR EACL ;) R0 (LR C CKLO BERXF ;K>BLSB-MNDBEMS-<T0MI XLLCA R TEINPOK OCBLE AV;S R01, ROV M RTTA STOT INPO ;) R2-(T TS K OCBLS OUVIRE PET;G1 ,R2)(R -OV M$: 2L VELET ENEMCRDE ;C MAEC DLLCA L UL NIFH NCRA;B 2$Q BE K OCBLT EX TTO)$: MOV #MT.RPT,R5 ;FUDGE AN "END OF REPEAT" REPTF: CALL WCIMT CALL MPUSH ;PUSH PREVIOUS MACRO BLOCK MOV (SP)+,(R2)+ ;STORE TEXT POINTER MOV (SP)+,(R2)+ ;STORE ARG POINTER CLR (R2)+ ;COUNTER MOV (SP)+,(R2)+ ;MAX SETCHR ;RESTORE CHARACTER ENDRPT: MOV #MSBCNT,R0 ;SET POINTER TO COUNT INC (R0) ;BUMP IT CMP (R0)+,(R0)+ ;THROUGH? BGT 1$ ; YES MOV MSBTXT,(R0) ;NO, SET READ POINTER ADD #4,(R0) ;BYPASS LINK RETURN 1$: JMP MPOP ENDR: ERROR O RETURN .GLOBL MACRO, ENDM *#BADBFB,R0 .OPENO #LPLB,R0 ;OPEN DATASET TST @BADB ;ANY BAD BLOCKS ? BNE LISTB1 ;YES .WRITE #LPLB,#NOBADB ;NO, PRINT MESSAGE .WAIT #LPLB LISTBE: .CLOSE #LPLB ;CLOSE DATASET JSR R5,REGRES ;RESTORE REGISTERS RTS PC ;RETURN ; THE REMAINDER OF THIS SUBROUTINE IS ; FOR RP DISKS EXCLUSIVELY AND IS NOT ; NECESSARILY THE CORRECT ALGORITHM ; FOR OTHER DISKS. LISTB1: .WRITE #LPLB,#BADBTL ;PRINT HEADER .WAIT #LPLB B2SRP: MOV BADB,R0 ;BAD BLOCK POINTER B2SRP0: MOV (R0)+,R5 ;GET BLOC#4V MO H NCRA B -NO ;0 T0BO LEQ B S?ORRR EALAT FNY;A) R33(R,TEFA #TBBI E AT W RYRAIB LUTTPOU ;6)(R,-LBOL #OV M TOE IN LXTNEE ITWR ; TERI W 6)(R,-LBOL #OV M ERFFBUE IN LTOS NTOI PR3 ;6)(R,-R3V MO: WROTLB PCS RT: 00IRLB ERFTLBP JM E OD CRYRAIB LUTNP IET;S R02, #OV M CHANBR- O ;N 00IRLBQ BE ? RSROERL TAFAY AN ;3)(R,3ERAT#FB IT B TEWA Y ARBRLIT PUIN ;6)(R,-LBIL #OV M OMFRE IN LXTNED EA;R D EA R 6)(R,-LBIL #OV M ERFFBUE IN LTOS NTOI PR3 ;6)(R,-R3V MO: RDINLB F BUIN LINE IN LLEDUMO ;T INPO ;R0),R2-(V MO: 1$ ITE OVEM;R ACMMREL AL C LLNUF ICHANBR ;$ 1EQ B CKLO BRG ATOR TEINPOT GE ;R0),R2-(V MO G ART AS POTSLE ONT INPO ;R22,G+ARSB#MV MO L VELEG INSTNEO CRMAP PO ; : OPMP XTBTMST ANGTIINPO2 RTHWIN URET;R N URET R NTOU CELEV LMPBU ;L LVAC MNC I ERNTOI PCKLO BUSIOEVPRD AN ;)+R2,()+SP (OV M PETYE AV;S+ 2)(R5, ROV M ONTINATIES DRECOE AK MS,YE ;R2+,P)(SV MO O N; 1$E BN ? GHOUHR;T1 ,RNDBEMS #MP C OTSLE OR CARLE;C )+R1 (LR C EMITN AERXF ;)+R2,(1)(RV MO: 1$ RSTEINPO- MACRO: ;MACRO DEFINITION GSARG ;GET THE NAME BEQ ENDM ; ERROR IF NULL MSRCH ;SEARCH THE TABLE MOV VALUE,R0 ;GET THE POINTER BEQ 1$ ;BRANCH IF NULL CALL DECMAC ;DECREMENT THE REFERENCE 1$: CALL GETBLK ;GET A STORAGE BLOCK MOV R0,VALUE ;SET POINTER INSERT ;INSERT IN TABLE CALL PROMA ;PROCESS DUMMY ARGS CLR (R2)+ ;CLEAR LEVEL COUNT MOV ARGCNT,(R2)+ ;KEEP NUMBER OF ARGS BIS #LC.MD,LCFLAG CALL ENDLIN ;POLISH OFF LINE CALL PROMT ;PROCESS THE TEXT MOV #MT.MAC,R5.K NO. TST R5 ;ANY MORE BLOCK NOS ? BEQ B2SRP4 ;NO, RETURN MOV R5,R4 ;YES, SAVE BLOCK NO. CLR R3 ;CYLINDER ADDRESS GOES HERE MOV #20000.,R1 ;CONVERT BLOCK NO. TO SECTOR MOV #100.,R2 ;ADDRESS B2SRP1: SUB R1,R5 BCS 3$ ADD R2,R3 1$: ASR R1 ;THE ALGORITHM IS A CMP R1,#600. ;PROGRAMMED TABLE LOOKUP BNE 2$ ;IT IS, IN ESSENCE, A MOV #800.,R1 ;BINARY SEARCH. MOV #8.,R2 2$: ASR R2 BEQ 4$ BCC B2SRP1 MOV #2400.,R1 BR B2SRP1 3$: ADD R1,R5 BR 1$ 4$: SUB #10.,R5 BCS 5$ INC PTS R BJ OSTIR FTHWIN URET;RD NRBI,LPCR JS G LA FHE TARLE;C IREDLBB LR C NELIR DID ENE THE ITWR ;WROTLBC, PSR J5:W0BD L0 W0BD LBR Y TRENS HI TTERI;WE XTBN,LPCR JS H NCRA B -ES;Y 05DWLBE BN ? UFNBLIN IIR DND;E IREDLBB ST T0:W0BD L3 ,RUFNBLI #OV M RYTOECIR DNGTIRI WESSHNIFI ; : RTDWLB PCS RT S ESDRADD TEDAUPP PO ;+ 6)(RT TS 2 M+NABT,L)+R6 (OV M TYLITI U +2AMTNLB& M NABT LINT PU ;) R6-(R CL M NABT,L)+R6 (OV M TYLITI U 6)(R -LR C 4)(R -ATE AM NTOR TEINPO ;6)(R,-4)(R -OV M MENAE OR CND A; ) SP-(1, ROV M ONTINATIES DVESA ;P)(S,-R2V MO E YPOTOTPRF ORTTA STOR TEINPO ;R1K,BLSB#MV MO T ARSTO TNTOI;P 2)(R -ST T CKLO BGERATO S AET;G LKTBGEL AL C ELEV LNGTIES NROAC MSHPU ; : SHPU M RNTURE: AXMMRE XTCNMA+,P)(SV MO ) R0,(XTCNMAV MO: 2$ 1$R B NKLI, NO ;0 ,R0)(RV MO S YE ;$ 2EQ B N?AICHF OND;E 0)(RT TS: 1$ ERNTOI PVESA ;P)(S,-R0V MO: ACMMRE VETIGANEN-NOF IITEXT US;J AXMMREL BP E AGORSTO CRMAT ENEMCRDE ;) R02(C DE: ACCMDE RNTURE E NCREFEREO CRMAT ENEMCRIN1 CALL WCIMT ;SET END MARKER SETCHR RETURN MCALL: ;MACRO CALL SETPF0 ;MARK LOCATION MOV VALUE,R0 ;GET BLOCK POINTER MOV R0,-(SP) CALL INCMAC ;INCREMENT REFERENCE CMP (R0)+,(R0)+ ;MOVE UP A COUPLE OF SLOTS MOV (R0)+,ARGMAX ;SET NUMBER OF ARGS MOV R0,-(SP) ;SAVE POINTER CALL PROMC ;PROCESS CALL ARGUMENTS MOV R0,R3 ;SAVE BLOCK POINTER MOV #MT.MAC,R5 CALL MPUSH ;PUSH NESTING LEVEL MOV (SP)+,MSBMRP MOV (SP)+,(R2)+ ;SET TEXT POINTER MOV R3,(R2)+ ; AND ARGUMENT PO2C R2 BR 4$ 5$: ADD #10.,R5 SWAB R2 ;R3 CONTAINS CYLINDER ADD R5,R2 ;R2 CONTAINS SECTOR, TRACK CMP #256.,BSZW ;IS IT RP03 ? BEQ B2SRP3 ;NO, IT IS RP02 B2SRP2: BIC #160360,R2 ;CONTINUE BLOCK TO SECTOR ;CONVERSION ASL R2 ;S=2S, T=2T ASL R3 ;C=2C CMPB #8.,R2 ;S>8. ? BPL 2$ ;S< OR = 8. 1$: ADD #366,R2 ;S=S-10., T=T+1 2$: SWAB R2 ;GET TRACT NO. CMPB #19.,R2 ;T>19. ? BPL 4$ ;T< OR = 19. 3$: INC R3 ;C=C+1 SUB #20.,R2 ;T=T-20. 4$: SWAB R2 B2SRP3: MOV R2,R1 ;RM OKSAC;P M:KOBP L C PTS R5:N1BE L5 N0BE LBR 4 RNC I0:N1BE L0 N0BE LBR 4 ,R#3D AD: 05ENLB 15ENLBT BL 0 N1BE LEQ B R5C DE Y ITILUT R FEUF BIN ;6)(R,-#1V MO E ACPLD ANE AM NCKPAUN ;6)(R,-R4V MO ) R6-(+,2)(RV MO: 00ENLB 4)(R 6RBCL R FEUF BOMFR. E TH ;0 N0BE LNE B ARLE CENTH, NTTEEXO NIF ;) R24(T TS 5 ,R#2V MO R FEUF BTOS NTOI PR4 ; E AM NTOS NTOI PR2 ; : NMERLB C PTS R RDWOR TOCADIINP PO ;+ 6)(RT TS S ERNTOI PHE TTSSEREX TAYN;S X TAYN S 6)(R,-FHBUCM #OV M RSPTE IL FUTTP ;) R02(C IN: ACCMIN RNTURE T ISTPAT INPO, LLCEK IN LARLE;C )+R2 (LR C R20, ROV M$: 2N AICHW NET SE ;XTCNMA),R0 (OV M$: 1 O ;N 1ORRRSE S YE ;$ 2HI B M?OO;R) R2,(+0ASLBROP CM P TOW NEE UTMPCO ;2)(RB,PM#BD AD 0 ,R2)(RV MO E AGORSTF OOP TTOT INPO, NO ;R2P,TOAC#MV MO T ISE US,YE ;$ 1NE B GEBAAR GINK OCBLR FOT ES;T0 ,RXTCNMAV MO K OCBLO CRMAA T GE ; : LKTBGE RNTURE T SES AGFLG INAVLE, TERI;W+ 2)(R5, RVBMO: 3$ )+SP (ST T NKLIW NET SE ;P)(S,@R0V MO K BLET GLLCA ) SP-(2, ROV5INTER SETCHR RETURN ENDMAC: JMP MPOP ENDM: ERROR O RETURN .GLOBL IRP, IRPC IRPC: INC R3 IRP: CALL GMARG BEQ 1$ MOV R0,-(SP) CALL PROMA MOV (SP)+,R0 CALL RMARG CALL GMARG BEQ 1$ MOV (R0)+,-(SP) MOV (R0)+,-(SP) MOV R0,-(SP) TSTARG MOV #177777,ARGMAX ;ANY NUMBER OF ARGUMENTS CALL PROMCF MOV R0,R3 MOV (SP)+,R0 MOV (SP)+,-(R0) MOV (SP)+,-(R0) CALL RMARG CALL GETBLK CLR (R2)+ MOV ARGCNT,-(SP) MOV R3,-(SP) MOV R0,-(SP) CALL ENDLIN CALL PR63 - CYLINDER BIC #177760,R1 ;R2 - TRACK SWAB R2 ;R1 - SECTOR BIC #177740,R2 .BIN2O #BDBB,R4 ;BLOCK .BIN2O #BDBC,R3 ;CYLINDER .BIN2O #BDBT,R2 ;TRACK .BIN2O #BDBS,R1 ;SECTOR .WRITE #LPLB,#LSTBLK ;PRINT BLOCK NO. AND .WAIT #LPLB ;EQUIVALENT SECTOR ADDRESS CMP #256.,BSZW ;IS IT RP02 ? BEQ B2SRP0 ;YES INCB BDBS6 ;NO .WRITE #LPLB,#LSTBLK ;PRINT NEXT SECTOR NO. DUE .WAIT #LPLB ;TO RP03 DENSITY BR B2SRP0 B2SRP4: .WRITE #LPLB,#BDBEND ;LIST BADB.SYS .WAIT #LPLB JMP LISTBEOUD ANT PUINS ETES;R T:RSLB PCS RT R TOCADIINP PO ;+ 6)(RT TS: L2IRLB PCS RT H NCRA B -ES;Y L0IRLBQ BE ? UTNP IREMOY AN ;+ 6)(RT TS H NCRA B -ES;Y L2IRLBE BN ? REHE TNGHIYTAN ;6 B+FL IST T1:RLBI LR ROERH TCWI SSSCERO;P ERSWLBP JM E OD CLEFIT PUINT SE ;0 RLR C CHANBR- O ;N L1IRLBQ BE ? ESCHITSWY AN MOO;T6 @RR,WE#ST BI S ICNTMASE ) R6-(M,SELB #OV M0:RLBI L4 M+SELBB,FF#IV MO 2 M+SELBB,FL#IV MO I CSM RO FUTNP ISTUEEQ;R FHBUCMR CL: RLBI LE ICEV DSEEAEL;R E ASLERE ) R6-(B,FL#IV MO M NKLIO TNTOI PO,;N2 ,RMBBP #UB S ES Y; 3$E BN ? CKLO BISTHN IOMRO ;R21,B-PM#BT BI: 2$ NTNCCOR CL: 1$ MTCI WBR 5 ,R)+SP (OV M 2$L AL C R5L,XCH.#CV MO R TEACARCHT ENRRCUK ACST, ES;Y) SP-(5, ROV M NO ;$ 1MI B G?INNDPES ARCHN IOATENATNCCOY AN ;T CNON CEC D EETRO CRMAN IERCTRAHA CTERI;W T:IMWC T ECCS . ERNTOI;P W LK.B R TEACARCH" EDOWRRBO;" W LK.B: SVRGMA REPUIMT ECCS . RNTURE B TNSE T PNHR,C0)(RV MO ) R0 (DC A R5L AS ) R0@(5, RVBMO 5 ,R)+R0 (OV M NTMEGUARO CRMAE OVEM9OMT MOV #MT.IRP,R5 JMP REPTF 1$: ERROR A RETURN PROMA: ;PROCESS MACRO ARGS ZAP DMAROL TSTARG CLR ARGCNT 1$: TSTARG BEQ 3$ CALL GETSYM BEQ 2$ APPEND DMAROL BR 1$ 2$: ERROR A 3$: RETURN PROMC: CLR R3 PROMCF: CLR ARGCNT CALL GETBLK MOV R0,-(SP) TST R3 BNE 5$ 1$: CMP ARGMAX,ARGCNT BLOS 10$ CALL GMARG BEQ 10$ MOV R0,-(SP) 2$: CALL WCIMT BEQ 3$ GETCHR BR 2$ 3$: MOV (SP)+,R0 CALL RMARG BR 1$ 4$: INC ARGCNT GETCHR 5$: CALL WCIMT BEQ 1: .SBTTL CONVERT ASCII STRING OF OCTAL CHARACTERS TO BINARY ;CVT CONVERTS AN ASCII STRING OF OCTAL CHARS. INTO BINARY. ; RO POINTS TO THE CHARACTER IN THE ASCII STRING ; R1 CONTAINS THE BINARY CONVERSION ; R2 CONTAINS THE CHARACTER UNDER CONVERSION ; UPON ENTRY, R0 POINTS TO THE FIRST CHARACTER ; OF THE STRING. UPON EXIT, R0 POINTS TO THE ; FIRST CHARACTER FOLLOWING THE LAST OCTAL ASCII CHAR. ; AND R1 CONTAINS THE BINARY CONVERSION OF THE ; OCTAL STRING. CVT: CLR R1 ;CONVERTED NO. = 0 1$: E IL FSELO;C E OSCL ) R6-(B,FL#IV MO E OR MNOF I 0 =+6LBIF ; . XTNES ET;G ND ALEFIT PUINS SEEAEL;R L:NRBI L C PTS R5:NIBI LR FEBI LMP J3:NIBI LE IN LSD G AOT;N I5INLBQ BE S INELIT RSFIF IORRR;EA DTBF,LSD#GP CM 3 NIBI LNE B OF EIFY SHFIS G'INTHMESO ;3)(R,3OF#EB IT B NELIT RSFID EA;RL NFBI,LPCR JS 3 ,RBFFLLB #OV M LEFIT PUINN PE;O N PE O 6)(R,-LBIF #OV M 6)(R,-FBIF #OV M CEVIDET NI;I T NI I 6)(R,-LBIF #OV M ERIZALTINI ILEFIT PUIN ; : ININLB A L0BO LBR 4 B+LF,OMP#T;R G:ARRM N URET RX:RGMA GG ARF ORTTA SET;S R CHET S RTTA STOT INPO ;2)(R+,P)(SV MO R PEOPSTT SE ;) R2@(B LR C ERCTRAHA CND A; ) R0-(5, ROV M ERNTOI PVESA ;0)(R,-2)(RV MO 0 ,R+4SVRGMA #OV M$:21 AORRR E$:20 1$ 2BR G ARRMN ISTPAE OV MSTMU ;R50,0000#1S BI " "<T AS PNTOI;P P)(SC IN H UGROTHT NOF IOPLO ;$ 11L BP 1 RNC I$:12 R1C DE T UNCOL VELET ENEMCRDE, ES;Y R1C DE N AIAGY TR, NO ;$ 11E BN ? >" "O,;N R45, RMP C ES Y; 2$ 1EQ B "?"<; R35, RMP C OL EIFR ROER ;$ 20Q BE R =0$ CLR R5 CALL WCIMT BR 4$ 10$: COM R5 CALL WCIMT COM R5 BIT #LC.MC,LCMASK ;MACRO CALL SUPPRESSION? BEQ 12$ ; NO MOV LBLEND,R0 ;YES, HAVE WE A LABEL? BEQ 11$ ; NO, SUPPRESS ENTIRE LINE MOV R0,LCENDL ;YES, LIST ONLY LABEL BR 12$ 11$: BIS #LC.MC,LCFLAG 12$: MOV (SP)+,R0 RETURN PROMT: CLR R3 1$: CALL GETMLI BMI 2$ BIT #DFLMAC,R0 BEQ 3$ INC R3 CMP #ENDM,VALUE BNE 3$ DEC R3 DEC R3 BPL 3$ 2$: RETURN 3$: MOV #LINBUF,CHRPNT SETCHR 4$: GETSYM BEQ 7> MOVB (R0)+,R2 ;GET ASCII CHAR, BUMP PTR. SUB #'0,R2 ;IS CHAR A NUMBER ? BMI 2$ ;NO, EXIT CMP #7,R2 ;IS CHAR AN OCTAL NO ? BMI 2$ ;NO,EXIT ASL R1 ;YES, ADD IT TO CONVERTED NO. ASL R1 ASL R1 ADD R2,R1 BR 1$ ;GET NEXT CHAR 2$: DEC R0 ;POINT TO FIRST NON-OCTAL CHAR RTS PC ;RETURN .SBTTL READ INPUT STRING FROM KB AND DELETE SPACES ;KBINP READS AN INPUT COMMAND STRING FROM THE KB ; AND DELETES ALL SPACES FROM IT KBINP: JSR R5,REGSAV ;SAVE REGS USED BY KBINP .READ #TTYLB,#V MO 2 B+LF,O11#RV MO B LF,OIB#LV MO A L0BO LNE B -1FBOL2, #PBCM 4 B-LF OLR C FGNMREC IN: 0BOLLB PCS RT 4 B-LF OLR C WROTLBC, PSR J R3R,HDIB#LV MO N PE O 6)(R,-LBOL #OV M 6)(R,-FBOL #OV MA:L0BO L4 B-LF,O0BOLLB #OV M 0AOLLBQ BE B LL IST T ITIN ) R6-(B,LL#OV MO R ZELIIAITINY ARBRLIT PUUT;O N:LIBO L PCS RT 0 L0BI LNE B ORRR ERYRAIB LUTNP IANS ;AA ATBD,LSD#GP CM T IAGFLE ISRWHEOT, RYRAIB;LD NRBI,LPCR JS: 05ILLB IDAL V AISS HI TMESUAS ;R LEBI LMP J0:L0BI L, OKE ARS ERADHEO TWT RSFIF CHET G$:11 NTLEVAUIEQ" "> ;4 ,RR5V MO T ENALIVQU E<" "NO ;3 ROM C ERNTOI PEW NET;S) SP,(2)(RV MO L UL NIFR ROER ;$ 20Q BE T ISSPABY, ^" " ; NBET G$:10 ENEV . 0B,TA, CEPA SM,COH. CC,SMH. CTEBY .$: 4 $ 1BR R TEACARCHT EX NET GS,YE ; HRTCGE O N; 2$E BN ? STLIF OND EO,;N )+R0 (TBTS S YE ;$ 21Q BE S ERITIMEL DSTTE ;) R0,(R5B MP C$: 2E BLTAT SER,HEITNE ;0 ,R4$ #OV M$: 1S YE ;$ 10Q BE ? OWRR-AUP ;AR.UCH,#R5P CM S YE ;$ 11Q BE ? UETR ;3 ,RR5P CM 4 ,RAB.RCH #OV M >""<E UMSS;A3 $ SCAN DMAROL MOV R0,R4 BEQ 5$ MOV ROLUPD,R5 NEG R5 DEC CONCNT CALL WCIMT DEC CONCNT 5$: SETSYM 6$: TST R4 BNE 61$ CALL WCIMT 61$: GETR50 BGT 6$ 7$: CMP R5,#CH.XCL BEQ 8$ CALL WCIMT BNE 9$ CALL ENDLIN BR 1$ 8$: INC CONCNT 9$: GETCHR BR 4$ GMARG: ;GET MACRO ARGUMENT TSTARG ;TEST FOR NULL BEQ GMARGX ; YES, JUST EXIT GMARGF: SAVREG ;STASH REGISTERS CLR R1 ;CLEAR COUNT MOV #CHRPNT,R2 MOV (R2),-(SP) ;SAVE INITIAL CHARACTER POINTER MOV #CH.LAB,RRQBUF ;READ THE INPUT .WAIT #TTYLB MOV #RESDTA,R1 ;POINT TO INPUT BUFFER MOV R1,R2 1$: CMPB (R1)+,#SPACE ;IS CHAR A SPACE ? BEQ 1$ ;YES, IGNORE IT MOVB -1(R1),(R2)+ ;NO, SAVE IT CMPB #LF,(R2) ;END OF STRING ? BNE 1$ ;NO, CONTINUE. JSR R5,REGRES ;YES, RESTORE REGISTERS RTS PC ;AND RETURN. .SBTTL ROUTINE TO SAVE REGISTERS ON STACK REGSAV: MOV R4,-(SP) ;PUSH REGISTER CONTENTS MOV R3,-(SP) ;(R5 SAVED BY ENTRY) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV R5,PC ;EXIT WITHOUT ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������